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/'We  have  implemented  an  interpreter  for  A  rule-based  system,  AMORD,  based  on 
a  non-chronological  control  structure  and  a  system  of  automatically 
maintained  data-dependencies.  The  purpose  of  this  paper  is  to  serve  as  a 
reference  manual  and  as  an  implementation  tutorial.  -We -wish— to%411ustratey  , 
{1}  The  discipline  of  explicit  control  and  dependencies,'  '  - 
{2}  How  to  use  AMORD;  and 

{3}  One  way  to  implement  the  mechanisms  provided  by  AMORD. w  This  paper  Is 
organized  into  sections.  The  first  section  is  a  short  "reference  manual" 
describing  the  major  features  of  AMORD.  Next,  we  present  some  examples 
which  illustrate  the  style  of  expression  encouraged  by  AMORD.  This  style 
makes  control  information  explicit  in  a  rule-manipulable  form,  and  depends 
on  an  understanding  of  the  use  of  non-chronological  justifications  f-or 
program  beliefs  as  a  means  for  determining  the  current  set  of  beliefs.  The 
third  section  is  a  brief  description  of  the  Truth  Maintenance  System 
employed  by  AMORD  for  maintaining  these  justifications  and  program  beliefs. 
The  fourth  section  presents  a  complete  annotated  interpreter  for  AMORD, 
written  in  MacLISP. 
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Section  1:  The  AMORD  Reference  Manual 


^  1 

■  ^  AMORir™^0  is  a  system  for  writing  problem  solvers.  "AAOR0J, encourages 
a  style  of  expression  in  which  the  logical  relationships  of  the  knowledge 
and  control  structure  of  the  problem  solver  are  made  explicit.  A  minimal 
set  of  mechanisms  is  supplied  by  AMORD  so  that  most  of  the  knowledge  that 
must  be  formalized  and  the  decisions  that  must  be  made  in  constructing  a 
problem  solving  program  must,  to  a  large  degree,  be  made  explicit  in  AMORD. 
This  makes  AMORD  a  vehicle  for  expressing  the  structure  of  problem 
solvers.  Once  the  problem  solving  structure  has  been  formalized,  the  task 
of  transferral  to  programs  in  programming  languages  is  straightforward. 
The  important  aspect  of  AMORD  is  the  discipline  of  explicit  control  it 
enforces,  rather  than  the  specific  language  or  syntax  in  which  the  control 
knowledge  is  expressed. 


The  basic  mechanism  of  AMORD  is  the  pattern-directed  invocation  of  a 
set  of  rules  operating  on  an  indexed  data  base  of  assertions.  ^AMOfiD^ 
features  a  simple  syntax  for  rule  invocation  patterns,  an  unconstrained 
format  for  assertions,  unification  semantics  for  the  pattern-matcher,  a  / 

non-chronological  control  structure  for  rule  invocations,  and  the  use  of  a 
truth  maintenance  system™s  for  determining  the  current  set  of  believed 
assertions.  AMORD  is  implemented  in  MacLISP.M#cUSP 


The  main  components  of  AMORD  are  two  discrimination  networks,  one  for 
storing  assertions  and  one  for  storing  rules,  the  TMS,  the  matcher,  and  the 
queue.  The  TMS  is  a  system  for  maintaining  the  logical  grounds  for  belief 
in  assertions.  The  matcher  is  a  syntactic  unifier  which  has  no 
distinguished  positions  or  keywords.  The  queue  is  a  system  whereby  rules 
are  run  on  the  appropriate  assertions.  The  main  loop  of  the  AMORD 
interpreter  is  to  simply  run  the  body  of  all  rules  on  all  currently 
believed  assertions  whose  patterns  match  the  rules'  patterns.  This  is  done 
independent  of  the  chronological  order  in  which  the  assertions  and  rules 
are  entered  into  the  data  bases.  When  all  rules  have  been  run  on  all 
matching  facts,  AMORD  halts,  awaiting  further  user  input. 


There  are  several  special  constructs  in  AMORD  for  expressing  rules 
and  assertions.  We  will  enumerate  them  here,  accompanied  by  their  syntax 
and  description.  In  these  descriptions,  expressions  of  the  form  "<...>" 
denote  meta-syntactic  variables. 


ASSERT  --  (ASSERT  <PATTERN>  <JUSTIFICRTION>) 

This  is  the  method  for  adding  a  new  assertion  (also  called  a  "fact") 
to  the  data  base.  Any  variables  in  the  arguments  inherit  their  values  from 
the  lexically  surrounding  text.  Variables  are  denoted  by  atoms  with  a 
colon  prefix,  as  in  M:F".  Each  fact  in  the  data  base  has  an  atomic 
factname.  Assertions  which  are  variants  of  each  other  denote  the  same  fact 
in  the  data  base,  that  is,  are  mapped  to  the  same  factname.  The 
justification  is  a  list,  whose  interpretation  is  determined  by  the  first 
element  of  the  list.  If  the  first  element  is  atomic  and  has  a  "proof-type" 
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function  associated  with  it,  that  function  is  applied  to  the  justification 
and  assertion  to  construct  the  desired  TMS  justification.  Otherwise, 
belief  in  the  assertion  is  justified  by  belief  in  all  of  the  facts  in  the 
rest  of  the  justification.  The  addition  of  a  new  assertion  to  the  data 
base  causes  all  rules  with  patterns  matching  the  assertion  to  be  run. 

RULE  --  (RULE  (<FflCTNRME-VRRIRBLE>  <PRTTERN>)  <B00Y>) 

This  is  the  method  for  adding  rules  to  the  rule  data  base.  A  rule  is 
a  procedure  to  be  invoiced  by  all  assertions  matching  <prttern>.  When  a  fact 
whose  pattern  unifies  with  the  rule  pattern  is  ASSERTed,  the  set  of  AMORD 
and  LISP  forms  specified  in  the  body  of  the  rule  are  evaluated  in  the 
environment  specified  by  adding  {1}  the  variable  bindings  derived  from  the 
unification  of  the  fact  pattern  and  rule  pattern  to  {2}  the  binding  of  the 
fact's  factname  and  the  factname  variable  of  the  rule  pattern  and  {3}  the 
bindings  derived  from  the  lexically  surrounding  (AMORD,  not  LISP)  text.00***' 
The  primary  use  of  the  factname  variable  is  for  use  in  specifying 
justifications  in  assertions  made  in  the  rule  body.  Rules  are  run  on  all 
matching  facts.  The  order  in  which  they  are  run  is  not  specified,  although 
the  interpreter  of  Section  4  can  be  observed  to  operate  in  a  quasi-depth- 
first  fashion. 

ASSUME  --  (ASSUME  <PRTTERN>  <JUSTIFICRTION>) 

This  is  used  to  assert  speculative  hypotheses,  that  is,  to  assume  a 
truth  "for  the  sake  of  argument”.  Here  the  <justificrtion>  should  specify 
support  for  the  need  for  assuming  the  <prttern>  assertion.  Assumptions  are 
made  by  justifying  belief  in  the  assumed  assertion  on  the  basis  of  a  lack 
of  belief  in  the  assumed  assertion's  negation.  Thus,  assumptions  may  be 
discarded  by  justifying  belief  in  the  negation  of  the  assumed  assertion, 
which  invalidates  the  justification  previously  supporting  belief  in  the 
assumed  fact.  In  particular,  the  dependency-directed  backtracking 
mechanism  of  the  TMS  uses  the  information  gained  through  analysis  of  the 
reasons  for  contradictions  to  retract  conflicting  assumptions  in  this 
manner. 


The  following  macros  can  be  used  to  interface  expressions  manipulated 
by  the  AMORD  and  LISP  interpreters. 

PDSVAL  --  (POSVrl  <form>> 

This  macro  allows  LISP  code  to  access  the  AMORD  value  of  <forh>,  that 
is,  the  value  of  all  variables  prefixed  by  colons  are  substituted  into  the 
returned  form. 

PDSLET  --  (PDSLET  ( (<VRR1>  <VRL1>)  ...  (<VRRN»  <VRIN>)>  <B00Y>) 

This  macro  enables  the  binding  of  a  number  of  AMORD  variables  to 
values  expressed  by  LISP  expressions.  Note  that  the  AMORD  variables  must 
be  prefixed  by  a  colon. 

PDSCLOSE  --  (POSCLOSE  <B0DY») 

This  macro  allows  the  evaluation  of  AMORD  forms  from  within  LISP  when 
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the  LISP  expression  being  evaluated  is  not  lexically  surrounded  by  an  AMORD 
expression.  The  forms  in  the  body  are  evaluated  in  an  empty  AMORD 
environment,  that  is,  an  environment  in  which  no  AMORD  variables  are  bound. 

CONSTANT  --  (CONSTANT  <0BJECT>) 

This  LISP  predicate  determines  whether  an  object  contains  any 
references  to  AMORD  variables. 


The  following  are  used  to  initialize  and  invoke  the  AMORD  interpreter. 

INIT  —  (INIT) 

This  function  initializes  the  data  bases  and  various  system 
variables. 

RUN  —  (RUN) 

This  function  initiates  the  AMORD  read-evaluate  loop.  Forms  read  in 
this  loop  are  closed  in  the  empty  environment  and  then  evaluated.  Unlike 
the  LISP  read-evaluate-print  loop,  the  results  of  the  evaluation  of  forms 
in  this  loop  are  not  printed. 

STOP  --  (STOP) 

This  function  when  read  by  the  AMORD  read-evaluate  loop  causes  the 
loop  to  halt  and  return  to  LISP.  AMORD  can  be  invoked  again  without  loss 
of  information  by  calling  RUN,  as  above. 

fA  —  fa 

This  interrupt  character  (Control-A)  performs  the  same  function  as 
STOP  above.  If  typed  while  AMORD  is  running,  this  character  causes  the 
loop  to  halt  at  the  next  available  point.  The  queues  are  left  intact,  so 
tn(RUN)  is  a  no-op. 


The  following  functions  the  dependency  structures  and  the  data  base. 

WHY  --  (UHY  <FACTNAI1E>) 

This  prints  the  current  justification  for  belief  in  the  specified 

fact. 

EXPLAIN  —  (EXPLAIN  <FACTNAHE>) 

This  prints  the  complete  proof  of  belief  in  the  specified  fact. 

PROOFS  --  (PROOFS  <FACTNAHE>) 

This  prints  each  of  the  currently  valid  justifications  for  belief  in 
the  specified  fact. 

INSPECT  --  (INSPECT  *<PATTERN>) 

This  function  prints  all  of  the  assertions  with  patterns  matching  the 
given  pattern.  Each  assertion  is  printed  with  its  factname  and,  if  it  Is 
believed,  its  current  justification. 
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There  are  also  a  number  of  functions  internal  to  the  interpreter 
which  are  useful  in  writing  specialized  functions.  The  TMS  functions  and 
their  use  are  described  in  Section  3.  The  most  important  are  the  following* 

ASSERTION  --  (ASSERTION  *<PATTERN>) 

This  returns  the  factname  of  the  fact  with  the  designated  pattern. 

FACT-STATEMENT  --  (fact-statement  <factnahe>) 

This  returns  the  pattern  associated  with  the  designated  fact. 

RETRACT  --  (RETRACT  <FACTNAf1E>) 

This  removes  all  PREMISE  type  justifications  possessed  by  the 
supplied  fact. 


There  are  several  standard  forms  of  justifications  built  into  AMORD. 
These  are  for  use  in  the  justification  field  of  ASSERT  and  ASSUME. 

PREMISE  --  (PREMISE) 

This  justification  supports  belief  independent  of  any  other  beliefs. 

GIVEN  --  (GIVEN) 

A  synonym  for  PREMISE. 

CONDITIONAL- PROOF  --  (conditional -proof  <consequent>  <hypotheses>> 

This  justification  provides  support  if  the  current  set  of 
justifications  for  facts  provide  for  belief  in  the  consequent  when  all  the 
hypotheses  are  believed.  Actually,  this  justification  type  has  a  somewhat 
more  complex  capability  and  syntax  which  consistently  extend  the  syntax  and 
function  just  described.  The  concepts  involved  in  this  extension  are 
described  in  Section  3,  and  the  syntax  is  described  in  the  annotated 
implementation  in  Section  4. 

CP  --  (CP  <CONSEQUENT>  <HYPOTHESES>) 

A  synonym  for  CONDITIONAL-PROOF. 

CONTRADICTION  —  (contradiction  <support>) 

This  justification  declares  the  fact  justified  by  this  justification 
to  be  a  contradiction.  It  supports  belief  in  the  justified  fact  if  all  the 
facts  mentioned  in  <support>  are  believed.  The  declaration  of  the 
contradiction  will  cause  backtracking  to  be  invoked  whenever  the  justified 
fact  is  believed.  All  contradictions  must  be  explicitly  declared.  That 
is,  asserting  facts  which  syntactically  are  negations  of  each  other  does 
not  automatically  produce  a  contradiction. 

In  addition  to  the  above  justification  types,  the  justification  types 
ASSUMPTION,  INSTANCE  and  RULE  are  used  internally  by  the  interpreter  in 
making  hypothetical  assumptions,  in  making  justifications  based  on 
subsumption  of  one  fact  by  another,  and  in  justify*''.,  rules.  These 
justification  types  should  therefore  be  avoided  by  the  user. 
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To  use  AMORD,  simply  incant  at  DDT  (on  NIT-AI): 
: AMORD 


or 

AMORDtR, 

which  will  load  up  the  current  version  of  AMORD  and  enter  the  LISP  read- 
evaluate-print  loop.  To  enter  the  AMORD  read-evaluate  loop,  evaluate  the 
form  (RUN),  which  will  begin  interpretation.  To  escape  to  LISP,  type  tG, 
or  (STOP)  or  tA  as  described  above. 

This  concludes  the  AMORD  reference  manual. 
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Section  2:  Some  AMORD  Examples 


The  structure  of  AMORD  encourages  a  certain  style  of  rule-writing. 
In  order  to  compute  anything,  the  control  of  the  computational  process  must 
be  made  explicit .Eltpl,cit  Con,ro1  The  use  of  explicit  control  requires  careful 
thought  about  making  the  correct  justifications  for  belief  in  assertions. 
This  section  presents  a  simple  deductive  system  in  AMORD  to  illustrate 
these  points. 

The  forward  version  of  conjunction  introduction  can  be  implemented  in 
AMORD  as  the  following  rule: 

(RULE  (:F  iR) 

(RULE  (iG  iB> 

(ASSERT  (AND  iA  iB)  («+  iF  iG>>>> 

This  rule  may  be  paraphrased  as  follows:  the  addition  of  a  fact  A  with 
factname  f  into  the  data  base  results  in  the  addition  of  a  rule  which  takes 
every  fact  B  in  the  data  base  and  asserts  the  conjunction  of  a  and  B.  Thus 
if  foo  is  asserted,  so  will  be  (and  foo  foo>  ,  (and  foo  (and  foo  food,  (and  <ano  foo  Foot 
foo)  ,  etc.  Note  that  the  atom  and  is  not  a  distinguished  symbol. 

Unfortunately,  this  rule  is  useless,  as  it  generates  piles  of  useless 
assertions.  To  control  these  deductions,  the  above  rule  can  be  replaced  by 
the  following  rule  which  performs  consequent  reasoning  about  conjunctive 
goals. 

(RULE  ( : G  (SHOU  (AND  iP  s Q) > ) 

(RULE  (i Cl  iP) 

(RULE  (:C2  :Q> 

(ASSERT  (ANO  iP  iQ)  (*♦  id  :C2>>> 

(ASSERT  (SHOU  iQ)  ( (BC  *♦>  iC  iCl>>> 

(ASSERT  (SHOU  iP)  ( (BC  *♦>  iG>>> 

In  this  rule  the  control  statements  (those  of  the  form  (Shou  ...»)  depend  on 
belief  in  the  relevant  controlled  facts  so  that  the  existence  of  a  subgoal 
for  the  second  conjunct  of  a  conjunctive  goal  depends  on  the  corresponding 
solution  to  the  first  conjunct.  At  the  same  time,  no  controlled  assertions 
depend  on  control  assertions,  since  the  justification  for  a  conjunction  is 
entirely  in  terms  of  the  conjuncts,  and  does  not  Involve  the  need  for 
deriving  the  conjunction.  This  means  that  the  control  over  the  derivation 
of  facts  cannot  affect  the  truth  of  the  derived  facts.  The  hierarchy  of 
nested,  lexically  scoped  rules  allows  the  specification  of  sequencing  and 
restriction  information  for  deriving  new  assertions.  For  Instance,  an 
alternative  method  of  conjunctive  subgoaling  can  be  written  as 
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(RULE  <:G  (SHOU  (RND  :P  iQ))) 

(RULE  (:C1  sP) 

(RULE  (:C2  :Q) 

(ASSERT  (AND  :P  :Q)  (4*  t Cl  iC2))>) 

(ASSERT  (SHOU  :P>  (<BC  4+)  sG>) 

(ASSERT  (SHOU  iQ)  ( (BC  4+)  iG))> 

This  rule  also  only  derives  correct  statements,  but  is  not  as  tightly 
controlled  as  the  previous  rule.  In  this  case,  both  subgoals  are  asserted 
immediately,  although  there  is  no  reason  to  work  on  the  second  conjunct 
unless  the  first  conjunct  has  been  solved.  This  form  of  the  rule  allows 
more  work  to  be  done  because  possible  mutual  constraints  between  the 
conjuncts  due  to  shared  variables  are  not  exploited.  That  is,  in  the  first 
consequent  rule,  solutions  to  the  first  conjunct  were  used  to  specialize 
the  subgoals  for  the  second  conjunct,  so  that  the  constraints  of  the 
solutions  to  the  first  are  accounted  for  in  the  second  subgoal.  In  the 
second  form  of  the  rule  much  work  might  be  done  on  solving  each  subgoal 
independently,  with  the  derivation  of  the  conjunction  performed  by  an 
explicit  matching  of  these  derived  results.  This  allows  solutions  to  the 
second  subgoal  to  be  derived  which  cannot  match  any  solution  to  the  first 
subgoal. 

Other  consequent  rules  for  Modus  Ponens,  Negated  Conjunction 
Introduction,  and  Double  Negation  Introduction  are  similar  in  spirit  to  the 
rule  for  Conjunction  Introduction: 

(RULE  (:G  (SHOU  :Q>) 

(RULE  (il  (->  iP  : Q) > 

(RULE  ( : F  iP) 

(ASSERT  :Q  (HP  si  tF>>> 

(ASSERT  (SHOU  :P>  ( (BC  HP)  sG  si)))) 

(RULE  (sG  (SHOU  (NOT  (AND  sP  s 0) ) > > 

(RULE  (sT  (NOT  s P) ) 

(ASSERT  (NOT  (AND  sP  sQ>)  (-4+  sT>)> 

(RULE  (sT  (NOT  sQ>> 

(ASSERT  (NOT  (RND  sP  sQ) )  (-4+  |T)>> 

(ASSERT  (SHOU  (NOT  sP>>  ((BC  -4+)  sG) > 

(ASSERT  (SHOU  (NOT  sQ>>  ( (BC  -4+)  sG>>> 

(RULE  (sG  (SHOU  (NOT  (NOT  sP)))) 

(RULE  (iF  sP) 

(ASSERT  (NOT  (NOT  sP)>  (— ♦  sF)>) 

(ASSERT  (SHOU  sP)  ((BC  — ♦)  sG>>> 
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The  following  two  rules  implement  a  consequent  oracle  for  testing  the 
equality  of  constants.  Note  the  use  of  PDSVAL  in  allowing  LISP  access  to 
the  value  of  AMORD  variables. 

(RULE  (:Q  (SHOU  («  :fi  :B>>> 

(LET  ((R  (PDSVRL  ifl>> 

(B  (PDSVRL  : B) ) ) 

(IF  (CONSTANT  R) 

(IF  (CONSTANT  B> 

(IF  (EQUAL  A  B) 

(ASSERT  (>  iR  :B>  (EQURLITY) ) > ) > ) ) 

(RULE  (iQ  (SHOU  (NOT  (.  tR  :B>)>) 

(LET  UR  (POSVRL  :R>> 

(B  (POSVRL  : B) ) ) 

(IF  (CONSTANT  fl> 

(IF  (CONSTANT  B) 

(IF  (EQUAL  fl  B> 

NIL 

(ASSERT  (NOT  (.  iR  iB>)  (EQUALITY))))))) 


A  final  example  is  the  use  of  assumptions  to  implement  a  default 
series  of  alternative  choices.  The  following  expresses  the  knowledge  that 
traffic  signals  are  either  red,  yellow  or  green. 

(RULE  (iT  (TYPE  :L  TRAFFIC-SIGNAL)) 

(ASSUME  (COLOR  iL  GREEN)  (OPTIMISM  iT)) 

(RULE  (:NG  (NOT  (COLOR  :L  GREEN))) 

(ASSUME  (COLOR  sL  YELLOU)  (HOPE -YET  iT  : NG) ) 

(RULE  (sNY  (NOT  (COLOR  iL  YELLOU))) 

(ASSERT  (COLOR  iL  REO)  (RATS  iT  iNG  iNY) > ) > ) 

By  using  this  rule,  anything  declared  to  be  a  traffic  signal  will  be 
assumed  to  be  green  in  color.  If  it  is  discovered  (perhaps  due  to  a 
contradiction)  that  the  color  is  not  green,  the  color  will  be  assumed  to  be 
yellow.  If  it  is  further  discovered  that  the  color  is  also  not  yellow,  the 
color  is  determined  to  be  red.  After  creating  a  number  of  such  traffic 
signals,  their  colors  can  be  determined  by  interrogating  AMORD  with 

(INSPECT  *  (COLOR  iX  s Y) >  . 


d«  Klaer,  Doyle,  Rich,  Steele  S  Sussman 


11 


Tha  Uaa  of  tha  THS  In  RHORO 


Section  3:  The  Use  of  the  TMS  in  AMORD 


The  Truth  Maintenance  System  is  an  Independent  program  for  recording 
information  about  program  deductions.  The  TMS  uses  a  method  for 
representing  knowledge  about  beliefs,  called  a  non-monotonic  dependency 
system,  to  effect  any  updating  of  beliefs  necessary  upon  the  addition  of 
new  information. 

The  basic  operation  of  the  TMS  is  to  attach  a  justification  to  a  TMS- 
node.  A  TMS-node  can  be  linked  with  any  component  of  program  knowledge 
which  is  to  be  connected  with  othsr  components  of  program  knowledge.  In 
AMORD,  each  fact  and  rule  has  an  associated  TMS-node.  The  TMS  then 
decides,  on  the  basis  of  the  justifications  attached  to  nodes,  which 
beliefs  in  the  truth  of  nodes  are  supported  by  the  recorded  justifications. 
A  node  is  said  to  be  rn  if  there  is  an  associated  justification  which 
supports  belief  in  the  node.  Otherwise,  the  node  is  said  to  be  our.  The 
TMS  informs  AMORD  whenever  the  belief  status  of  a  node  changes,  either  from 
in  to  out,  or  out  to  in. 

There  are  several  types  of  justifications  supported  by  the  TMS.  The 
basic  form  of  a  justification  is  one  in  which  a  node  is  justified  if  each 
node  in  a  set  of  other  nodes  is  in.  This  type  of  justification  represents 
the  typical  form  of  a  deduction,  or  in  the  special  case  in  which  the  set  of 
other  nodes  is  empty,  a  premise.  A  node  may  also  be  justified  on  the  basis 
of  the  conditional  proof  of  one  node  relative  to  a  set  of  other  nodes.  In 
this,  belief  in  the  justified  node  is  supported  if  the  consequent  node  of 
the  conditional  proof  is  in  when  each  of  the  nodes  in  the  set  of  hypotheses 
is  in.  The  remaining  form  of  justification  supports  belief  in  a  node  if 
each  node  in  a  given  set  of  other  nodes  is  out.  This  non-monotonic 
justification  allows  the  consistent  representation  and  maintenance  of 
hypothetical  assumptions.  Using  this  latter  form  of  justification,  a  fact 
can  be  assumed  to  be  true  by  justifying  it  on  the  basis  of  its  negation 
being  out. 

Each  node  which  is  in  has  a  distinguished  element  of  its  set  of 
justifications.  This  distinguished  justification  is  selected  to  support 
belief  in  the  node  in  terms  of  other  nodes  having  well-founded  support, 
that  is,  non-circular  proofs  from  ground  hypotheses.  A  number  of 
dependency  relations  are  determined  from  these  justifications,  such  as  the 
set  of  nodes  depending  on  a  given  node,  or  the  nodes  upon  which  a 
particular  node  depends. 

Truth  maintenance  processing  is  required  when  new  justifications 
cause  changes  in  previously  existing  beliefs.  In  such  cases,  the  status  of 
all  nodes  depending  on  the  nodes  with  changed  beliefs  must  be  redetermined. 
The  critical  aspect  of  this  processing  is  ensuring  that  all  nodes  judged  to 
be  in  are  associated  with  well-founded  support.  Truth  maintenance  is 
reminiscent  of  a  generalized  and  incremental  garbage  collection.  The  first 
step  is  to  mark  and  collect  all  facts  whose  current  belief  state  depends, 
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via  the  previously  recorded  consequence  dependencies,  on  the  changed 
beliefs.  The  second  step  is  a  combination  sweep  and  depth  first  search 
over  these  facts  with  the  purpose  of  determining  belief  states  based  on 
other  facts  with  well-founded  support.  By  distinguishing  facts  with  well- 
founded  support  from  those  without,  all  new  beliefs  determined  in  this  pass 
are  guaranteed  to  be  well-founded.  The  third  step  is  necessary  if  the 
second  step  does  not  determine  belief  states  for  all  the  involved  facts. 
This  step  consists  of  a  relaxation  process  of  assuming  some  belief  states 
and  proceeding,  taking  care  that  the  assumed  beliefs  are  consistent.  This 
step,  at  its  conclusion,  can  guarantee  that  all  beliefs  have  well-founded 
support.  The  fourth  step  is  a  pass  over  all  changed  facts  to  check  for 
believed  facts  which  are  known  to  represent  contradictions.  Backtracking 
is  invoked  on  any  such  contradictions  (which  may  so  invoke  further  truth 
maintenance).  The  final  step  of  truth  maintenance  is  the  notification  of 
the  external  systems  of  all  changes  in  beliefs  determined  by  the  truth 
maintenance  system. 

The  TMS  provides  automatic  dependency-directed  backtracking  whenever 
nodes  marked  as  contradictions  are  brought  in.  Dependency-directed 
backtracking  employs  the  recorded  dependencies  to  locate  precisely  those 
hypotheses  relevant  to  the  failure  and  uses  the  conditional  proof  mechanism 
to  summarize  the  cause  of  the  contradiction  in  terms  of  these  hypotheses. 
Because  the  reasons  for  the  failure  are  summarized  in  a  form  which  is 
independent  of  the  hypotheses  causing  the  failure,  future  occurrences  of 
similar  failures  are  avoided. 

The  TMS  functions  used  in  AMORD  are  as  follows: 

TMS-MAKE- DEPENDENCY -NODE  --  (THS-urke-depenoency-nooe  <externrl-nrne>) 

This  function  creates  a  new  TMS-node  with  a  given  name.  In  AMORD, 
the  external  names  are  just  the  atomic  factnames  used  to  represent  facts 
and  rules.  TMS-nodes  are  currently  implemented  using  uninterned  atomic 
symbols. 

TMS- JUSTIFY  --  (TtlS-JUSTIFY  <N00E>  <INSUPPORTERS>  <0UTSUPP0RTERS>  <RRGUHENT>) 

This  function  gives  a  TMS  node  a  new  justification,  which  is  valid  if 
each  of  the  nodes  of  the  insupporters  list  is  in,  and  each  of  the  nodes  of 
the  ouf supporters  list  is  out.  The  argument  is  an  uninterpreted  slot  used 
to  record  the  external  form  of  the  justification,  and  is  retrievable  via 
the  TMS-ANTECEDENT-ARGUMENT  function  described  below. 

TMS- CP -JUSTIFY 

--  (TfIS-CP-JUSTIFY  <NOOE>  <CONSEQUENT>  <1NHYP0THESES>  <0UTHYP0THESES>  <RRGUI1ENT>) 

This  gives  a  TMS  node  a  new  justification  which  is  valid  if  the 
consequent  node  is  believed  when  the  inhypotheses  are  in  and  the  out 
hypotheses  are  out.  As  in  TMS-JUSTIFY,  the  argument  is  an  uninterpreted 
record  of  the  external  form  of  the  justification. 
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TMS-PROCESS-CONTRADICTION 

--  < THS-PROCESS-CONTRRO ICTION  <NRHE>  <N00E>  <TYPE>  <CONTRRDICTION-FUNCTJON>) 

This  declares  a  TMS  node  to  represent  a  contradiction.  The  name  and 
type  are  uninterpreted  mnemonics  provided  by  the  external  system  to  be 
printed  out  during  backtracking.  The  contradiction-function,  if  supplied, 
should  be  a  LISP  function  to  be  called  with  the  contradiction  node  as  its 
argument  when  the  backtracker  can  find  no  backtrackable  choicepoints. 

TMS-SUPPORT-STATUS  --  uhs-support-strtus  <nooe») 

This  function  returns  the  support-status,  either  'IN  or  'OUT,  of  a 

node . 

TMS-ANTECEDENT-SET  --  (TUS-rnteceoent-set  <node>) 

This  function  returns  the  list  of  justifications  of  the  node.  In  the 
TMS,  each  justification  is  called  an  antecedent  of  the  node. 

TMS-SUPPORTING-ANITECEDENT  --  (TtlS-SUPPORTlNG-RNTECEOENT  <N0DE>) 

This  function  returns  the  current  justification  of  the  node. 

TMS-ANTECEDENT -ARGUMENT  --  <THS-RNTECEDENT-flRGUHENT  <rntecedent>) 

This  function  returns  the  external  argument  associated  with  the  given 
antecedent. 

TMS-ANTECEDENTS  --  (TOS-RNTECEDENTS  <N0DE>) 

This  function  returns  the  list  of  nodes  determining  well-founded 
support  for  the  given  node.  This  list  is  extracted  from  the  supporting- 
antecedent  if  the  node  is  in,  and  is  empty  if  the  node  is  out. 

TMS- CONSEQUENCES  --  (ths-consequences  <nooe>> 

This  function  returns  the  list  of  nodes  whose  list  of  antecedent 
nodes  mentions  the  given  node. 

TMS- EXTERNAL -NAME  --  (tus-externrl-nrhe  <nooe>) 

This  function  returns  the  user-supplied  name  of  a  node. 

TMS-IS-IN  --  <Tns-is-lN  <nooe>) 

This  predicate  is  true  iff  the  node  is  in. 

TMS-IS-OUT  --  (TRS-IS-OUT  <NOOE>) 

This  predicate  is  true  iff  the  node  is  out. 

TMS-RETRACT  --  iths-retrrct  <mode>) 

This  function  will  remove  all  premise-type  justifications  from  the 
set  of  justifications  of  the  node. 

TMS-PREMISES  --  <Tf1S-PREHlSES  <N00E>) 

This  function  returns  a  list  of  the  premises  among  the  well-founded 
support  of  the  node. 
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TMS-ASSUMPTIONS  --  cms-nssimPTiONS  <nooe>) 

This  function  returns  a  list  of  the  assumptions  among  the  well- 
founded  support  of  the  node. 

The  TMS  also  generates  new  "facts"  internally  during  backtracking. 
These  will  therefore  occur  in  explanations  and  antecedents  of  the  nodes 
requested  and  justified  by  the  external  systems.  The  internal  facts 
generated  by  the  TMS  are  atoms  with  certain  properties.  The  following 
functions  are  provided  to  manipulate  these  internal  facts. 

TMS-FACTP  --  (THS-FRCTP  <THING>) 

This  predicate  is  true  iff  the  thing  is  an  internal  TMS  fact. 

TMS- FACT-NODE  --  (tms-frct-nooe  <frct>) 

This  function  returns  the  TMS  node  associated  with  an  internal  fact. 

TMS- FACT- STATEMENT  --  (ths-frct-strtehent  <frct>> 

This  function  returns  the  symbolic  statement  of  the  meaning  of  an 
internal  fact.  This  statement  refers  to  the  external  names  of  the  other 
facts,  such  as  contradictions  and  assumptions,  which  were  involved  in  the 
making  of  the  fact. 


The  following  two  functions  are  supplied  for  debugging  purposes. 

TMS-INIT  --  (TKS-INIT) 

This  function  clears  the  state  of  the  TMS  by  resetting  all  internal 
variables  and  clearing  all  properties  and  internings  of  TMS  nodes. 

TMS- INTERN  --  chis-intern) 

This  function  interns  all  TMS  nodes  currently  in  existence,  and 
causes  the  interning  of  all  nodes  generated  in  the  future.  Initially,  the 
atomic  symbols  representing  TMS  nodes  are  not  interned. 

Examples  of  the  use  of  the  TMS  facilities  can  be  found  in  the 
following  section,  in  which  the  functions  implementing  the  various  AMORD 
proof -types  are  defined. 
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Section  4:  An  Annotated  Interpreter 


Here  we  present  an  actual  AMORD  interpreter.  The  interpreter  divides 
into  the  following  sections,  which  will  be  presented  in  this  order. 

AMORD  form  definitions 

ASSERT  and  associated  functions 
RULE  and  associated  functions 

Proof-type  definitions 

The  RUN  interpreter  (the  main  loop) 

The  TMS  interface 

The  Unification  Matcher 

The  Discrimination-Net  Data  Base 

Before  presenting  the  interpreter  itself,  we  describe  some  aspects  of  the 
implementation. 

The  main  loop  of  the  interpreter  is  in  the  function  RUN,  which 
examines  the  various  queues  (described  below).  RUN  makes  sure  that  all 
rules  are  run  on  all  facts  whose  patterns  match  the  rule  patterns.  As  an 
efficiency  measure,  a  rule  is  run  on  a  fact  only  if  both  the  rule  and  fact 
are  believed  (in).  After  the  possibilities  for  running  rules  on  facts  are 
exhausted,  RUN  checks  for  programs  (called  "runlast"  functions)  which  have 
been  specified  for  running  at  queue's  end  and  runs  each  of  these  programs. 
If  these  programs  make  new  assertions  or  rules,  the  above  loop  is  resumed. 
Finally,  after  finishing  all  of  the  above  steps,  RUN  prints  out  a  prompt 
string  and  waits  for  new  input  from  the  user. 

Each  rule  and  fact  is  represented  by  an  atomic  symbol.  The 
information  used  by  AMORD  is  stored  in  a  data  structure  kept  as  the  value 
of  the  atomic  symbol.  In  these  data  structures  are  the  TMS-nodes  of  the 
rules  and  facts  and  the  "stimulate-lists",  which  store  matching  facts  and 
rules  (respectively)  until  they  are  queued  up  to  be  run. 

In  addition,  rules  and  facts  have  other  attached  items.  Facts'  have 
their  statement,  and  rules  have  their  full  trigger  pattern  (the  list  of  the 
factname  variable  and  the  trigger  pattern  proper).  Rules  are  distinguished 
from  facts  by  their  possession  of  an  extra  data  structure  containing  the 
uninstantiated  rule  body  and  the  environment  of  AMORD  variable  bindings 
derived  from  the  lexically  surrounding  text. 

The  control  of  running  rules  on  facts  is  mediated  by  an  amorphous 
mechanism  called  the  queue.  This  mechanism  has  several  components: 

(I)  The  trigger  queue,  *TQ*.  This  is  a  queue  of  rule-fact  pairs 
representing  possible  triggerings.  This  queue  is  maintained,  in  the  global 
variable  *TQ*,  as  a  CONS  cell,  the  CAR  of  which  points  to  the  front  of  the 
list  of  trigger  pairs,  and  the  CDR  of  which  points  to  the  last  cell  of  this 
list.  This  is  done  so  that  new  pairs  may  be  quickly  added  to  the  end  of 
the  list  of  trigger  pairs. 


d«  Klaar,  Ooyla,  Rich,  Staala  &  Suasaan 


16 


An  Annotatad  Intarpratar 


(2)  The  stimulate  lists.  Each  rule  and  fact  has  a  list,  of  facts  and 
rules  respectively  called  its  "stimulate-list" .  These  facts  and  rules  In 
these  lists  are  initially  the  items  retrieved  from  the  data  base  as 
possibly  matching  the  newly  created  rule  or  fact.  The  function  STIMULATE, 
called  by  the  TMS  when  rules  and  facts  come  in,  takes  the  stimulate-list  of 
the  newly  irtned  item,  turns  it  into  a  list  of  pairs  and  adds  these  pairs  to 
the  trigger  queue. 

The  queue  mechanism  operates  as  follows.  When  pairs  come  to  the  top 
of  the  trigger  queue,  both  the  rule  and  the  fact  of  the  pair  are  checked  to 
see  if  they  are  in.  If  both  are  in,  their  unification  is  attempted.  (The 
matching  done  by  the  data  base  fetch  routines  only  provides  candidates  for 
the  true  unification  match.)  If  they  do  not  unify,  the  pair  is  discarded 
from  the  queueing  system:  if  they  do,  the  rule  body  is  evaluated  in  the 
derived  environment.  Alternatively,  if  a  pair  is  encountered  on  the 
trigger  queue  with  the  rule  (or  fact)  out,  the  fact  (or  rule)  is  placed  on 
the  STIMULATE-LIST  of  the  out  rule  (or  fact).  In  this  way  (1)  pairs  are 
not  run  until  they  become  relevant,  and  (2)  pairs  are  run  at  most  once,  for 
subsequent  innings  of  the  rules  or  facts  involved  will  keep  adding  the  pair 
to  the  trigger  queue  until  the  pair  makes  it  to  the  top  with  both  items  in, 
at  which  time  the  pair  will  run  and  leave  the  queue  system. 

In  addition  to  the  above  trigger  queue  mechanism,  two  other 
structures  are  part  of  the  main  RUN  loop. 

(1)  The  closure  queue,  *Q*.  This  is  queue  of  arbitrary  LISP  forms  to 
be  evaluated.  The  global  variable  *Q*  contains  this  queue,  in  the  form  of 
a  CONS  whose  CAR  is  the  first  cell  of  the  list  forming  the  queue,  and  whose 
CDR  is  the  last  cell  of  this  list.  As  in  the  trigger  queue,  this  is  done 
so  that  new  queue  items  can  be  added  directly  at  the  end  of  the  queue, 
rather  than  requiring  a  traversal  through  the  entire  queue  for  each  new 
addition.  This  queue  is  provided  so  that  the  user  may  post  programs  to  be 
executed.  This  is  sometimes  (although  rarely)  necessary,  as  the  TMS  makes 
the  restriction  that  the  TMS  cannot  be  invoked  while  a  previous  invocation 
is  still  signalling  changes  in  the  statuses  of  facts. 

(2)  The  runlast  list,  *RUNLAST*.  This  is  a  user  maintained  list, 
initially  empty,  of  LISP  forms  to  be  evaluated  each  time  both  *TQ*  and  *Q* 
run  out.  At  such  time,  each  form  in  this  list  is  evaluated.  These  forms 
can  either  add  new  justifications  to  facts,  add  other  programs  to  *Q*  to  be 
run,  or,  by  means  of  PDSCLOSE,  evaluate  further  ANORD  forms  to  cause 
resumption  of  the  main  loop  of  trigger  queue  interpretation. 

The  structure  of  justifications  is  as  follows.  Justifications  must 
be  lists.  If  the  first  element  of  the  list  is  either  non-atomlc,  or  lacks 
a  'PROOF-TYPE  property  if  atomic,  the  justification  is  interpreted  as  a 
simple  deductive  justification  in  which  the  justified  item  will  be  in  if 
all  the  facts  mentioned  in  the  rest  of  the  justification  are  in.  If  tht 
first  element  of  the  justification  is  an  atom  with  a  'PROOF-TYPE  property, 
the  the  value  of  that  property  must  be  a  LISP  function.  This  function  is 
called  with  the  justification  and  justified  item  as  arguments.  This 
function  then  has  the  responsibility  for  making  the  necessary  TMS 
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justifications,  and  may  perform  other  operations  if  desired.  Proof-type 
functions  which  must  evaluate  AMORD  forms  should  use  the  PDSCLOSE  macro 
described  in  Section  1. 

The  interpreter  uses  several  global  variables  as  follows: 

*Q*  -  The  queue  containing  LISP  forms  to  evaluate. 

*TQ*  -  The  trigger  queue  containing  rule-fact  pairs  to  close  and  run. 

•ENTRY*  -  Contains  the  last  *Q*  form  evaluated  by  RUN. 

•RUNLAST*  -  A  list  of  LISP  forms  to  be  successively  evaluated  each  time 
the  queue  runs  out.  This  list  is  initially  NIL. 

^STOPFLAG*  -  If  non-NIL,  causes  the  RUN  loop  to  halt  after  running  the 
current  entry. 

•SUBSTITUTION*  -  This  variable  is  bound  by  TRY-RULE  to  the  current  AMORD 
environment  to  be  used  in  evaluating  rule  bodies. 

•T-LIST*  -  This  variable  is  bound  by  TRY-RULE  to  a  list  of  the 
triggering  assertion  and  executing  rule  for  use  in  justifying  subrules. 

•WALLP*  -  If  non-NIL,  causes  new  justifications  of  assertions  to  be 
displayed.  The  default  is  T. 

•RULE-WALLP*  -  If  non-NIL  and  if  *WALLP*  is  also  non-NIL,  causes  new 
justifications  of  rules  to  be  displayed.  The  default  is  NIL. 

*DN*  -  Contains  the  discrimination  net. 

•GENSYM-COUNTER*  -  The  counter  used  in  generating  rule  and  fact  names, 
numbers  for  standardizing  expressions  apart,  and  line  numbers. 

Here  begins  the  code  of  the  interpreter  proper.  Several  macros  are 
used  in  this  code,  including  the  substituting-quote  ",  which  returns  the 
next  form,  quoted  but  with  the  values  of  subforms  preceded  by  ,  substituted 
as  elements  of  list  structure,  and  with  the  values  of  subforms  preceded  by 
@  spliced  in  as  list  segments.  The  macros  DEFMAC,  IF,  and  LET  have  the 
obvious  meanings,  and  are  defined  both  during  compilation  and  in  the  AMORD 
runtime  environment. 

The  first  items  are  declarations  for  the  MacLISP  compiler. 

(DECLARE  UEXPR  TAS-CLOBBER-SIGNAL -RECALLING-FUNCTION  TfIS-INIT 
TAS-AAKE-DEPENDENCY-NOOE  THS-N00E  TfIS-NOOES 
TfIS-JUSTIFY  THS-CP-JUSTIFY  TAS-PROCESS-CONTRADICTION 
TflS-RETRACT  TAS-ASSUAPTIONS  TriS-PREfllSES  TAS-ALL -CONSEQUENCES 
TAS-ALL-ANTECEOENTS  TAS-ARE-OUT  TAS-ARE-IN  TAS-IS-OUT  TAS-IS-IN 
TAS-CONSEQUENCES  TAS-EXTERNAL-NAAE  TAS-ANTECEOENTS  TAS-ANTECEOENT-SET 
TAS-SUPPORTING-ANTECEOENT  TAS-ANTECEOENT-ARGUAENT  TAS-SUPPORT-STATUS 
TAS-FACT-NOOE  TAS-FACT-STATEAENT  TAS-FACTP  TIAESTAAP) 

UFEXPR  GCTUA) 

(SPECIAL  eUALLP*  *RULE-UALLP*  eSTOPFLRG*  »TQ«  »Q«  eENTRY*  eRUNLAST* 
eGENSYA-COUNTER*  ^SUBSTITUTION*  eT-LIST*)) 
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The  following  macros  define  the  data  structures  representing  rules 
and  assertions.  None  are  defined  following  compilation.  Functions  are 
provided  instead. 

(OECLARE  (MACROS  NIL))  (TURN  OFF  MACRO  RETENTION. 

(OEFMAC  GET-FACT-STATEMENT  (FACT)  "(CARR  (SYMEVAL  .FACT))) 

(OEFUN  FACT-STATEMENT  (F) 

(IF  (THS-FACTP  F)  (TMS-F ACT-STATEMENT  F)  (GET-FACT-STATEMENT  F))) 

(OEFMAC  GE T -RULE-PATTERN  (RULE)  “ (CAAR  (SYMEVAL  .RULE))) 

(OEFMAC  RULEP  (ITEM)  "(COOR  (SYMEVAL  .ITEM)))  (CHECKS  FOR  RULE  PARTS 

(OEFMAC  GET-THS-NOOE  (ITEM)  "(COAR  (SYMEVAL  .ITEM))) 

(OEFMAC  GET-STIMULATE-LIST  (ITEM)  "(CADR  (SYMEVAL  .ITEM))) 

(OEFMAC  SET-STIMULATE-LIST  (ITEM  STIM-LIST) 

” (RPLACA  (COR  (SYMEVAL  .ITEM))  , STIM-LIST)) 

(OEFMAC  GET-RULE-FUNCTION  (RULE)  "(CADOR  (SYMEVAL  .RULE))) 

(OEFMAC  GET-RULE-SPECIALIZATION  (RULE)  "(CDOOR  (SYMEVAL  .RULE))) 

(OEFMAC  MAKE-ASSERTION-STRUCTURE  (EXP  TMS-N  STIM-LIST) 

"(CONS  (CONS  ,EXP  .TMS-N)  (CONS  , STIM-LIST  NIL))) 

(OEFMAC  MAKE-RULE-STRUCTURE  (PAT  TMS-N  STIM-LIST  RULE-FUN  SPEC) 

"(CONS  (CONS  ,PAT  , TMS-N)  (CONS  .STIM-LIST  (CONS  .RULE-FUN  .SPEC)))) 


(OECLARE  (MACROS  T)> 


(TURN  ON  MACRO  RETENTION 
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AMORD  FORM  DEFINITIONS 


All  true  AMORD  forms  like  ASSERT  and  RULE  must  be  evaluated  in  a  LISP 
environment  in  which  the  variables  "SUBSTITUTION*  and  *T-LIST*  are  bound. 
To  achieve  this,  while  making  these  variables  invisible  to  the  user,  macros 
are  used  which  append  the  appropriate  variable  references  to  the  calls  to 
the  AMORD  primitives. 

Here  is  ASSERT,  which  takes  an  expression  and  a  justification, 
instantiates  them  with  the  current  environment  bindings,  inserts  the 
expression  into  the  data  base,  and  then  installs  the  justification  as  one 
of  the  expression's  justifications.  The  call  to  SUBSUME-CHECK.  serves  to 
add  new  justifications  to  the  new  fact  or  to  other  facts  based  on 
subsumptions  in  their  patterns. 

(OEFHAC  ASSERT  (EXPRESSION  JUSTIFICATION) 

" (ASSERT-2  ’.EXPRESSION  ’.JUSTIFICATION  *SUBSTITUTION*>> 

(OEFUN  ASSERT-2  (EXPRESSION  JUSTIFICATION  ALIST) 

(LET  ((A  (ASSERTION  (INSTANCE  EXPRESSION  ALIST)))) 

(INSTALL-JUST  (INSTANCE  JUSTIFICATION  ALIST)  A) 

(SUBSUME -CHECK  A))) 

The  operation  of  ASSUME  is  somewhat  more  complicated  than  that  of 
ASSERT,  as  two  facts  are  created  in  addition  to  the  specified  fact,  as  well 
as  one  additional  justification. 

(OEFMAC  ASSUME  (EXPRESSION  JUSTIFICATION) 

" (ASSUME -2  ’.EXPRESSION  ’.JUSTIFICATION  ^SUBSTITUTION*)) 

(DEFUN  ASSUME -2  (EXPRESSION  JUSTIFICATION  ALIST) 

(LET  ((EXPRESSION  (INSTANCE  EXPRESSION  ALIST))) 

(LET  ((A  (ASSERTION  EXPRESSION)) 

(AF  (ASSERTION  "(ASSUHEO  .EXPRESSION))) 

(N  (ASSERTION 

(IF  (EQ  (CAR  EXPRESSION)  ’NOT) 

(CAOR  EXPRESSION) 

"(NOT  .EXPRESSION))))) 

(INSTALL-JUST  (INSTANCE  JUSTIFICATION  ALIST)  AF) 

(INSTALL-JUST  "(ASSUMPTION  ,AF  ,N)  A) 

(SUBSUME-CHECK  A) 

(SUBSUME-CHECK  AF) 

(SUBSUME-CHECK  N)>)> 
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ASSERTION  is  the  function  for  creating  new  assertions.  The  data  base 
is  checked  to  see  if  it  contains  a  fact  with  a  variant  of  the  supplied 
pattern.  If  so,  that  fact  is  returned,  and  otherwise  a  new  fact  is 
generated  and  inserted  into  the  data  base  in  the  appropriate  bucket. 

(OEFUN  ASSERTION  (EXPRESSION) 

(LET  ((B  (BUCKET  EXPRESSION  NIL  'ASSERTION))) 

(00  ((L  (STUFF  B)  (COR  L>) 

(C>> 

((NULL  L) 

(LET  ( (NAME  (GENS  ’F))> 

(SET  NAHE 

(HAKE-ASSERT ION-STRUCTURE 
EXPRESSION 

(TMS-HAKE-OEPENDENCY-NODE  NAHE) 

(FETCH  EXPRESSION  NIL  ’RULE))) 

(INSERT-IN-BUCKET  NRHE  B) 

NAKED 

(SETQ  C  (COMPARE  EXPRESSION  (GET-FACT-STATEKENT  (CAR  L) >  > ) 

(AND  C  (EQ  (CAR  C)  ’VARIANT)  (RETURN  (CAR  L)>)>>) 

SUBSUME-CHECK  perforins  the  function  of  checking  the  data  base  for 
facts  whose  patterns  either  subsume  or  are  subsumed  by  the  pattern  of  the 
supplied  fact.  If  any  subsumptions  are  detected,  new  justifications  are 
added  to  support  belief  in  the  subsumed  fact  if  the  subsuming  fact  is 
believed. 

(OEFUN  SUBSUME -CHECK  (NAME) 

(LET  ((EXP  (GET-FACT-STATEHENT  NAME))) 

(00  ((CANDIDATES  (FETCH  EXP  NIL  ’ASSERTION)  (COR  CANOIOATESD 
(CD 

((NULL  CANDIDATES)) 

(CONO  ((EO  (CAR  CANOIORTES)  NAMED 

((NULL  (SETO  C  (COMPARE  EXP  (GET-FHCT-STATEnENT  (CAR  CANOIOATESD)))) 

((EO  (CAR  C)  ’SUBSUMES) 

(INSTALL-JUST  (LIST  ’INSTANCE  NAME)  (CAR  CANDIDATES))) 

((EQ  (CAR  C>  ’SUBSUMED) 

(INSTALL-JUST  (LIST  ’INSTANCE  (CAR  CANDIDATES))  NAMED 
(T  (BREAK  | SUBSUME -CHECK | )))))) 
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The  next  function  is  not  used  in  the  interpreter,  but  provides  a 
useful  service  in  writing  AMORD  rules  and  proof  types.  PRESENT  takes  as 
its  argument  a  full  rule  pattern  of  the  form  (<factnama>  <patiam>) .  It  returns 
a  list  of  substitutions  corresponding  to  all  matching  (subsumed  by  the 
pattern)  assertions  existing  in  the  data  base. 

(OEFUN  PRESENT  (PATTERN) 

(DO  ((CANDIDATES  (FETCH  (CADR  PATTERN)  NIL  ’ASSERTION)  (COR  CANDIDATES)) 

(ANS  NIL) 

(C>> 

((NULL  CANDIDATES)  ANS) 

(AND  (SETQ  C  (COtIPARE  (CADR  PATTERN)  (CET-F ACT-STATEMENT  (CAR  CANOIOATES) ) )  > 

(MEMO  (CAR  C)  ’(SUBSUMES  VARIANT)) 

(SETQ  ANS  (CONS  (CONS  (CONS  (CAR  PATTERN)  (CAR  CANDIDATES))  (CAOR  CM 
ANS))))) 

INSPECT  applies  PRESENT  to  a  useful  task.  It  prints  all  assertions 
matching  the  supplied  pattern,  in  order  of  ascending  factname. 

(DEFUN  INSPECT  (PATTERN) 

(SETQ  PATTERN  "((/:  aFACTNAME*  .  8)  .PATTERN)) 

(HAPC  ’ (LAMBDA  (SUB) 

(LET  ((I  (INSTANCE  PATTERN  SUB))) 

(CONO  ( ( IS— IN  (CAR  I)) 

(PRINT  I) 

(PRIN1  (ARGUMENT  (CAR  I)))) 

(T  (PRINT  I) 

(PRINC  ’  |  (OUT) |>))>) 

(SORT  (PRESENT  PATTERN)  ’ INSPECT-SORT)) 

’DONE) 

(OEFUN  INSPECT-SORT  (X  Y) 

(FACT-NAME -ALPHAGREATERP  (COAR  X)  (CDAR  YM) 

RULE-PRESENT  is  like  PRESENT  but  for  rules. 

(OEFUN  RULE-PRESENT  (PATTERN) 

(DC  ((CANOIOATES  (FETCH  PATTERN  NIL  ’RULE)  (COR  CANOIOATES)) 

(ANS  NIL) 

(CM 

((NULL  CANOIOATES)  ANS) 

(ANO  (SETQ  C  (COMPARE  PATTERN  (CAOR  (GET-RULE-PATTERN  (CAR  CANDIDATES))))) 

(MEMO  (CAR  C)  ’(SUBSUMES  VARIANT)) 

(SETQ  ANS  (CONS  (CONS  (CAR  CANDIDATES)  (CADR  CM 
ANS))))) 
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INSPECT-RULES  is  like  INSPECT  but  for  rules.  This  pretty-prints  the 
complete  rule  definitions,  so  prepare  for  a  lot  of  output. 

(OEFUN  INSPECT-RULES  (PATTERN) 

(LET  ((L  (SORT  (RULE-PRESENT  PATTERN)  * INSPECT-RULES-SORT)) ) 

(HAPC  * (LAUBOA  (SUB) 

(LET  ((I  (LIST  (CAR  SUB) 

(INSTANCE  (LIST  'RULE 

(GET-RULE-PATTERN  (CAR  SUB)) 
(GET-RULE-FUNCTION  (CAR  SUB))) 

(COR  SUB))))) 

(COND  <<IS-IN  (CAR  D) 

(SPRINTER  I) 

(PRINT  (ARGUMENT  (CAR  I))) 

(TERPRI) 

(TERPRI) ) 

(T  (SPRINTER  I) 

(PRINT  ’(OUT)) 

(TERPRI) 

(TERPRI))))) 

L)> 

’DONE) 

(OEFUN  INSPECT-RULES-SORT  (X  Y) 

(FACT-NAitE-ALPHAGREATERP  (CAR  X)  (CAR  Y>)) 

Rules  have  justifications  just  like  facts,  but  unlike  facts,  rules 
are  used  in  no  justifications  (other  than  in  justifying  their  subrules). 
Rules  are  really  operational  entities,  which  should  be  allowed  to  function 
only  if  the  facts  leading  to  their  creation  (via  other  rules  forming  its 
lexical  environment)  are  believed.  This  is  the  purpose  of  the  *T-LI5T* 
mechanism  seen  below  in  the  functions  for  defining  new  rules. 

(OEFMAC  RULE  (PATTERN  .  BOOY) 

"(RULE-2  *, PATTERN  \B00Y  ^SUBSTITUTION*  aT-LISTa)) 

(DEFUN  RULE-2  (PATTERN  RULE-FUNCTION  ALIST  T-LIST) 

(LET  ((B  (BUCKET  (CAOR  PATTERN)  ALIST  ’RULE)) 

(RNADE  (GENS  ’R>)> 

(SET  RNAtlE 

(flAKE -RULE -STRUCTURE 
PATTERN 

( THS-MAKE -0EPEN0ENCY-N00E  RNfiHE ) 

(FETCH  (CAOR  PATTERN)  ALIST  ’ASSERTION) 

RULE-FUNCTION 

ALIST)) 

(INSERT-IN-BUCKET  RNAflE  B) 

(INSTALL-JUST  •(RULE  .  .T-LIST)  RNAHE > ) ) 
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TRY-RULE  takes  a  possible  triggering  pair,  consisting  of  a  rule  and  a 
fact.  The  pattern  of  the  fact  is  compared  with  the  pattern  of  tha  rule. 
If  these  two  patterns  unify,  then  the  body  of  the  rule  is  evaluated  in  ths 
environment  produced  by  adding  the  bindings  derived  from  the  unification  to 
the  environment  in  which  the  rule  is  run. 

(OEFUN  TRY-RULE  (RNRflE  RHODE ) 

(LET  <<S  (UNIFY  (CRDR  (CET-RULE-PRTTERN  RNRI1E) ) 

(CET-FRCT-STflTEKENT  RHODE ) 

(GET -RULE-SPEC I RL IZRTION  RHODE) ) ) ) 

(IF  S 

(LET  (^SUBSTITUTION* 

“ ( (, (CAR  (GET-RULE-PRTTERM  RNRHE))  .  , RNRHE)  .  ,  (CAR  S>)> 

(•T-LIST* 

"(.rnahe  .rnrhe))) 

(HRPC  'EVRL  (GET-RULE-FUNCTION  RNRHE ))>>)) 
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PROOF-TYPES  AND  JUSTIFICATIONS 

INSTALL-JUST  takes  a  justification  and  a  fact  (or  rule).  If  the 
justification  has  an  associated  proof-type,  the  proof-type  function  is 
called  with  the  justification  and  fact  as  arguments.  Otherwise,  SUPPORT  is 
called  to  add  the  justification  to  the  set  of  justifications  of  the  fact. 
If  the  new  justification  causes  the  fact  to  be  newly  believed,  the  fact  and 
its  justification  may  be  displayed. 

(DEFUN  INSTflLl-JUST  (JUSTIFICATION  FACT) 

(LET  ((OIDSTATUS  (SUPPORT-STATUS  FACT))) 

(IF  (SYHB0LP  (CAR  JUSTIFICATION)) 

(LET  <(G  (GET  (CAR  JUSTIFICATION)  'PROOF -TYPE) >> 

(IF  G  (FUNCALL  G  JUSTIFICATION  FACT)  (SUPPORT  JUSTIFICATION  FACT))) 

(SUPPORT  JUSTIFICATION  FACT)) 

(ANO  ♦UALLP# 

(COND  ((RULEP  FACT) 

(CONO  ((AND  *RULE -UALLP* 

(EQ  OLOSTATUS  ’OUT) 

(EQ  (SUPPORT-STATUS  FACT)  ’IN)) 

(PRINT  ’DEFINING) 

(PRIN1  FACT) 

(PRINC  ’|  |> 

(SPRINTER  (INSTANCE  (LIST  ’RULE 

(GET-RULE-PATTERN  FACT) 

(GET-RULE-FUNCTION  FACT)) 
(GET-RULE-SPECIALIZATION  FACT))) 

(PRINC  ’|  |) 

(PRIN1  JUSTIFICATION) 

(TERPRI) 

(TERPRI)))) 

((AND  (EQ  OLOSTATUS  ’OUT) 

(EQ  (SUPPORT-STATUS  FACT)  ’IN)) 

(PRINT  ’ASSERTING) 

(PRIN1  FACT) 

(PRINC  ’|  |> 

(PRIN1  (GET-FACT-STATE RENT  FACT)) 

(PRINC  ’|  |) 

(PRIN1  JUSTIFICATION)))))) 

(SETQ  *UfiLLP*  T) 

(SETQ  *RULE-UALLP*  NIL) 
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SUPPORT  performs  the  standard  task  of  justification,  which  interprets 
all  elements  of  the  supplied  justification  (except  the  first,  which  is 
mnemonic)  to  be  factnames  which  collectively  justify  belief  in  the  supplied 
fact. 

(DEFUN  SUPPORT  (JUSTIFICATION  FACT) 

(THS-JUSTIFY  (THS-N00E  FACT) 

(TflS-NOOES  (COR  JUSTIFICATION)) 

NIL 

JUSTIFICATION)) 

PREMISE  justifies  the  fact  with  a  eternally  valid  justification. 

(DEFUN  PREflISE  (JUSTIFICATION  FACT) 

(THS-JUSTIFY  (TOS-NOOE  FACT)  NIL  NIL  JUSTIFICATION))) 

(PUTPROP  ’PREMISE  ’PREMISE  ’PROOF-TYPE) 

(PUTPROP  ’GIVEN  ’PREMISE  ’PROOF-TYPE) 

CONDITIONAL-PROOF  interprets  the  second  element  of  the  justification 
as  the  consequent  of  the  conditional  proof,  the  third  element  as  the  list 
of  in  hypotheses  of  the  conditional  proof,  and  the  fourth  element  as  the 
list  of  out  hypotheses  of  the  conditional  proof. 

(DEFUN  CONO I T I ONAL-PROOF  (JUSTIFICATION  FACT) 

(THS-CP-JUSTIFY  (TMS-NOOE  FACT) 

(TMS-NODE  (CADR  JUSTIFICATION)) 

(TMS-NOOES  (CAOOR  JUSTIFICATION)) 

(THS-NOOES  (CADDOR  JUSTIFICATION)) 

JUSTIFICATION)) 

(PUTPROP  ’CP  ’CONDITIONAL -PROOF  ’PROOF-TYPE) 

(PUTPROP  ’CONDITIONAL-PROOF  'CONDITIONAL-PROOF  ’PROOF-TYPE) 

ASSUMPTION  interprets  the  second  element  of  the  justification  as  a 
factname  designating  the  reason  for  making  the  assumption,  and  the  third 
element  as  a  factname  designating  a  negation  of  the  belief  to  be  assumed. 
Thus  the  supplied  fact  will  be  believed  whenever  the  reason  fact  is  in,  and 
the  negation  fact  is  out. 

(DEFUN  ASSUMPTION  (JUSTIFICATION  FACT) 

(TMS-JUSTIFY  (TMS-NOOE  FACT) 

(LIST  (TMS-NOOE  (CAOR  JUSTIFICATION))) 

(LIST  (TMS-NOOE  (CAOOR  JUSTIFICATION))) 

JUSTIFICATION)) 

(PUTPROP  ’ASSUMPTION  ’ASSUMPTION  ’PROOF-TYPE) 
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CONTRADICTION  first  supports  belief  in  the  supplied  fact  and  then 
declares  to  the  TMS  that  the  fact  is  a  contradiction. 

(DEFUN  CONTRADICTION  (JUSTIFICATION  FACT) 

(SUPPORT  JUSTIFICATION  FACT) 

(TnS-PROCESS-CONTRADICTION  FACT  (TfIS-NODE  FACT)  (GET-FACT-STATEHENT  FACT)  NIL)) 

(PUTPROP  ’CONTRADICTION  ’CONTRADICTION  ’PROOF-TYPE) 
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THE  RUN  INTERPRETER 

The  following  three  macros  hide  references  to  the  variables 
•SUBSTITUTION*  and  *T-LIST»,  allowing  LISP  and  AMORD  code  to  be  nixed. 

(0EFHAC  PDSVAL  (10)  “(INSTANCE  ’,10  eSUBSTITUTIONe)) 

(OEFftAC  POSLET  (VARS  .  BODY) 

"(LET  ( (eSUBSTITUTIONe 

,(00  ((A  ’eSUBSTITUTIONe 

“(CONS  (CONS  * , (CAAR  VL>  , (CAOAR  VL)>  ,A>> 

(VL  VARS  (COR  VL)>) 

((NULL  VL)  A)))) 

SBOOY) ) 

(OEFIIAC  POSCLOSE  BOOY  “(LET  ((eSUBSTITUTIONe  NIL)  (eT-LISTe  NIL))  eBOOY) ) 

RUN  has  four  loops  in  one.  First  the  trigger  queue  is  tried,  then 
the  main  queue,  then  the  runlast  functions,  and  finally  the  reader  is 
invoiced.  The  loop  is  halted  on  any  iteration  if  *STOPFLAG*  is  non-NIL. 

(DEFUN  RUN  () 

(PROG  (R  F) 

(SETQ  eSTOPFLAGe  NIL) 

LOOP  (CONO  (eSTOPFLAGe  (RETURN  ’STOPPEO)) 

((CAR  eTQe) 

(SETQ  R  (CAAAR  eTQe)) 

(SETO  F  (CDflflR  eTQe)) 

(RPLACA  eTQe  (COAR  eTQe)) 

(IF  (IS-IN  F) 

(IF  (IS-IN  R) 

(TRY-RULE  R  F) 

(SET-STIHULATE-LIST  R  (CONS  F  (GET-STIHULATE-LIST  R) ) > ) 
(SET-STItlULATE-LIST  F  (CONS  R  (GET-STIHULATE-LIST  F>>>> 

(GO  LOOP)) 

((CAR  eQe) 

(SETQ  eENTRYe  (CAAR  eQe)) 

(RPLACA  eQe  (COAR  eQe)) 

(EVAL  eENTRYe) 

(GO  LOOP))) 

(DO  URL  eRUNLASTe  (COR  RL>>> 

((NULL  RD) 

(EVAL  (CAR  RL))) 

(AND  (OR  (CAR  eTQe)  (CAR  eQe>>  (GO  LOOP)) 

(SETQ  eGENSYtl-COUNTERe  (♦  eGENSYII-COUNTERe  1)) 

(PRINT  eGENSYII-COUNTERe) 

(PRINC  '  |»  |) 

(ENQUEUE  (LIST  “(POSCLOSE  .(READ)))) 

(GO  LOOP))) 
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The  following  implement  the  RUN  loop  controllers. 

(DEFUN  AM0R0-RUN-1NTERRUPT  (X  Y)  (SETQ  aSTOPFLBCa  T)  ’RUN-INTERRUPTEO) 

(SSTflTUS  TTYINT  ’/TA  ’ RtlORD-RUN- 1 NTERRUPT) 

(DEFUN  STOP  ()  (SETQ  *ST0PFLAG«  T)> 

ENQUEUE  augments  *Q»  with  a  list  of  new  forms. 

(DEFUN  ENQUEUE  (RCT10NS) 

(IF  RCTIONS 

(LET  ((L  (LAST  ACTIONS))) 

(CONO  ((CAR  »Q*> 

(RPLRCO  (COR  aQa)  ACTIONS) 

(RPLRCO  *Q*  L)> 

(T  (RPLRCR  *Q*  ACTIONS) 

(RPLRCO  aQa  L>>>>>> 

STIMULATE  is  the  function  called  by  the  TMS  on  any  fact  or  rule  which 
changes  status  from  out  to  in .  When  such  a  status  change  takes  place,  all 
items  on  the  stimulate  list  are  used  to  add  new  pairs  to  the  trigger  queue. 
DESTIMULATE  is  the  complementary  function  called  when  assertions  or  rules 
go  from  in  to  out.  It  is  ignored  by  AMORD. 

(OEFUN  STIHULRTE  (NAME) 

(LET  ((ACTIONS  (IF  (RULEP  NAME) 

(HRPCAR  ’(LAMBDA  (F)  (CONS  NAME  F>>  (GET-STIMULATE-LIST  NAME)) 

(MRPCAR  ’(LAMBDA  (R)  (CONS  R  NAME))  (GET-STINULRTE-LIST  NAME))))) 
(SET-STIMULATE-LIST  NAME  NIL) 

(IF  ACTIONS 

(LET  ((L  (LAST  ACTIONS))) 

(CONO  ((CAR  aTQa) 

(RPLRCO  (COR  *TQ*>  ACTIONS) 

(RPLRCO  aTQa  L>> 

(T  (RPLRCR  *TQ*  ACTIONS) 

(RPLRCO  *TQ«  L)))))>) 


(OEFUN  OESTIMULATE  (NAME)  NIL) 
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INIT  performs  several  functions.  It  initializes  the  discrimination  net, 
the  TMS,  and  the  global  variables  of  the  AMORD  system.  It  also  attempts 
(by  a  somewhat  less  than  elegant  method)  to  rid  the  system  of  all 
assertions  and  rules  previously  created. 

< DEFUN  INIT  <> 

(DB1NIT) 

(THS-INIT) 

(SETQ  *0*  (CONS  NIL  NIL))  |CRR  IS  FIRST  CELL  OF  QUEUE,  COR  IS  LRST  CELL 
(SETQ  *TQ*  (CONS  NIL  NIL)) 

(SETQ  aRUNLAST*  NIL) 

(SETQ  aENTRY*  NIL) 

(SETQ  aSTOPFLAG*  NIL) 

(COND  ( (RNO  (BOUNOP  aGENSYN-COUNTERa) 

(NUMBERP  aGENSYN-COUNTERa) ) > 

(T  (SETQ  aGENSYII-COUNTER*  B))) 

( (LAMBDA  (BRSE  aNOPOINT) 

(DECLARE  (SPECIAL  BASE  aNOPOINT)) 

(00  ((I  1  (la  I)) 

(A)) 

((>  I  aGENSYN-COUNTERa)) 

(SETQ  A  (REAOLIST  (CONS  'F  (CONS  '-  (EXPLODE  I))))) 

(NAKUNBOUND  A) 

(SETPLIST  A  NIL) 

(RENOB  A) 

(SETQ  A  (REAOLIST  (CONS  ’R  (CONS  (EXPLOOE  I))))) 

(NAKUNBOUND  A) 

(SETPLIST  A  NIL) 

(RENOB  A))) 

8.  T) 

(GCTUR) 

(SETQ  aGENSYN-COUNTERa  6) 

’INITIALIZED) 
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Variables  are  represented  by  semi-lists  of  three  elements,  in  the 
form  </t  <var>  .  <numbar>)  The  first  element  is  the  atom  the  second  is 
the  variable  name,  and  the  third  is  a  number  used  to  standardize  the 
variable  name  apart.  The  following  functions  should  be  used  to  test  for 
them. 


(OEFUN  VARIABLE  <X>  (Ed  (CAR  X)  '/<>) 

CONSTANT  tests  whether  an  S-expression  contains  any  variables. 

(OEFUN  CONSTANT  (X) 

(C0N0  < (ATOn  X)  (NOT  (EQ  X  »/i)>> 

((CONSTANT  (CAR  X>>  (CONSTANT  (COR  X>))>> 

GENS  generates  a  new  atomic  symbol  with  a  supplied  prefix  and  a 
suffix  of  the  form  "-nnn". 


(OEFUN  GENS  (E) 

(REAOLIST  (NCONC  (EXPLOOE  E> 

(LIST  ’-> 

( (LAtlBOA  (BASE  *N0P0INT)  (AVOID  SCREWS  DUE  TO  BASE  CHANGES 

(DECLARE  (SPECIAL  BASE  *NOPOINT>) 

(EXPLOOE  (SETQ  aGENSYn -COUNTER* 

(♦  *CENSYI1 -COUNTER*  1)))) 


8.  T>>>> 


The  variable  designator  is  a  read  macro  which  generates  the 

standard  variable-structure  described  above.  Because  items  read  in  see  a 
constant  value  for  *GENSYM-COUNTER*,  variable  references  in  an  expression 
(such  as  two  occurrences  of  ":x")  appear  as  similar  structures  (such  as 

"(/«  *  .  127) "). 

(OEFUN  COLON-READ  ()  (CONS  »/i  (CONS  (READ)  *GENSYfl-COUNTER*l ) ) 


(SETSYNTAX  ’/>  ’ HACR0  ’COLON-READ) 
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THE  THS  INTERFACE 

WHY  presents  the  immediate  justification  for  the  current  belief  in  a 
fact.  Note  that  if  the  fact  is  not  believed,  the  list  of  failing 
justifications  is  printed.  PROOFS  prints  all  of  the  justifications 
possesed  by  an  assertion.  EXPLAIN  collects  up  all  facts  among  the  support 
of  the  supplied  fact,  sorts  them  by  the  suffix  of  their  factnane,  and 
prints  them  one  per  line  along  with  their  current  justifications. 

(OEFUN  UHY  (NAME) 

(PRINT  NAME) 

(PRIN1  (FACT-STATEMENT  NAME ) > 

•  (PR INC  *|  |> 

(IF  (IS-IN  NAME) 

(PR INI  (ARGUMENT  NAME)) 

(PRINT  (CONS  ’OUT 

(MAPCAR  ’ARGUMENT  (ANTECEOENT-SET  NAME))))) 

’QEO) 

(OEFUN  PROOFS  (FACT) 

(TERPRI)  (PRINC  ’  | PROOFS  OF  |>  (PRIN1  FACT)  (PRINC  ’|  -  |)  (PRIN1  (FACT-STATEMENT  FACT)) 
(PRINC  ’|  (|)  (PRINT  (SUPPORT-STATUS  FACT))  (PRINC  »(>  |> 

(MAPC  ’(LAMBDA  (A)  (PRINT  (THS-ANTECEOENT-ARGUMENT  A))) 

( THS -ANTECEDENT -SE T  (THS-NOOE  FACT))) 

’QEO) 

(OEFUN  EXPLAIN  (FACT) 

(TERPRI)  (PRINC  ’|PR00F  OF  |>  (PRIN1  FACT)  (PRINC  ’|  -  |)  (PRINT  (FACT-STATEMENT  FACT)) 

(PRINC  ’|  (|>  (PRINT  (SUPPORT-STATUS  FACT))  (PRINC  ’|)  |>  (PRINT  (ARGUMENT  FACT)) 

(PFL  (FOUNDATIONS  FACT)) 

’QEO) 

The  following  functions  do  the  dirty  work  for  functions  like  EXPLAIN. 

(OEFUN  PFL  (FL) 

(MAPC  ’ (LAMBOA  (F) 

(PRINT  F) 

(PRINC  ’|  •  |> 

(PRINT  (FACT-STATEMENT  F>) 

(PRINC  ’|  (|)  (PRINT  (SUPPORT-STATUS  F)>  (PRINC  ’|)  |) 

(PRINT  (ARGUMENT  F))> 

(SORT  (APPEND  FL  NIL)  ’FACT-NAME-ALPHAGREATERP))) 

(OEFUN  FACT-NAME-ALPHAGREATERP  (F  G) 

(GREATERP  (GENS-NUMBER-EXTRACT  F)  (GENS-NUHBER-EXTRACT  G>>> 

(OEFUN  GENS-NUMBER-EXTRACT  (X) 

(00  ((E  (COR  (MEMO  •-  (EXPLOOE  X)))  (COR  (MEMO  ’-  £>>>> 

((NOT  (MEMO  ’-  E)>  (REA0L1ST  E)))) 


d«  Klaar,  Ooyle,  Rich,  Steal*  4  Sunun 


32 


An  Annotated  Interpreter 


TNS-NODE  returns  the  TNS  node  associated  with  a  rule  or  fact.  The 
error  check  is  useful,  in  that  a  frequent  alstake  is  to  specify  a 
justification  with  a  constant  in  the  support  by  forgetting  to  prefix  a 
variable  name  with  a  colon. 

(DEFUN  TNS-NOOE  (F) 

(IF  (SVneOLP  F) 

(LET  ((N  (COND  ( (BOUNOP  F)  (GET-THS-NOOE  F>> 

( (THS-FACTP  F)  (THS-FACT-NOOE  F)>>>> 

(OR  N  (ERROR  ’|BA0  RRCUNENT  TO  TRS-N00E|  F  ’URNG-TYPE-ARC))) 

(ERROR  ’|BR0  RRCUNENT  TO  TNS-N00E|  F  ’ URNG -TYPE-ARG ) ) ) 

(OEFUN  TNS-NOOES  CL>  (HRPCRR  ’TNS-NOOE  L>) 

The  following  serve  to  interface  the  TNS  to  AMORD. 

(OEFUN  SUPPORT-STATUS  (FACT)  (TNS-SUPPORT-STRTUS  (TNS-NOOE  FACT!)) 

(OEFUN  RRCUNENT  (FACT)  (THS-RNTECEOENT-ARCUNENT  (TNS-SUPPORTINC-ANTECEOENT  (TNS-NOOE  FACT)))) 

(DEFUN  ANTECEDENT-SET  (FACT)  (THS-ANTECEOENT-SET  (TNS-NOOE  FACT))) 

(OEFUN  SUPPORTINC-ANTECEOENT  (FACT)  (TNS-SUPPORTINC-ANTECEOENT  (TNS-NOOE  FACT))) 

(OEFUN  ANTECEDENTS  (FACT) 

(NAPCAR  ’ THS-EXTERNAL-NANE  (TNS -ANTECEDENTS  (TNS-NOOE  FACT)))) 

(OEFUN  CONSEQUENCES  (FACT) 

(NAPCAR  'THS-EXTERNAL-NANE  (TNS-CONSEQUENCES  (TNS-NOOE  FACT)))) 

(OEFUN  IS— IN  (FACT)  (TNS-IS-IN  (TNS-NOOE  FACT))) 

(OEFUN  IS-OUT  (FACT)  (THS-IS-OUT  (TNS-NOOE  FACT))) 


(OEFUN  RRE-IN  (FACTS)  (TNS -ARE-IN  (TNS-NOOES  FACTS))) 

(OEFUN  ARE-OUT  (FACTS)  (TNS-ARE-OUT  (TNS-NOOES  FACTS))) 

(DEFUN  FOUNDATIONS  (FACT) 

(NAPCAR  ’ THS-EXTERNAL-NANE  (THS-ALL-ANTECEOENTS  (TNS-NOOE  FACT)))) 

(OEFUN  REPERCUSSIONS  (FACT) 

(NAPCAR  'THS-EXTERNAL-NANE  (TNS-ALL-CONSEQUENCES  (TNS-NOOE  FACT)))) 

(DEFUN  PRENISES  (NRNE)  (NAPCAR  'THS-EXTERNAL-NANE  (THS-PRENISES  (TNS-NOOE  NANE))>) 

(OEFUN  ASSUNPTIONS  (NANE)  (NAPCAR  'THS-EXTERNAL-NANE  (THS-ASSUHPTIONS  (TNS-NOOE  NANE))>) 
(OEFUN  RETRACT  (NANE)  (THS-RE TRACT  (TNS-NOOE  NANE))) 
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THE  UNIFICATION  MATCHER 

UNIFY  takes  two  expressions  and  a  substitution  as  input.  It  returns 
either  a  list  whose  first  element  is  a  substitution  which  yields  the  most 
general  common  unifier  of  the  expressions,  relative  to  the  given 
substitution,  if  they  can  be  unified,  or  NIL  if  they  cannot  be  unified. 
UNIFY  has  subroutines  for  the  matching  loop,  for  binding  matched  variables 
to  values,  and  for  checking  for  free  variable  occurrences  to  avoid 
erroneous  variable  capture. 

(DEFUN  UNIFY  (A  B  S) 

( (LAMBDA  (S)  (AND  S  (LIST  S)>) 

(UNIFY-HATCH  A  B  (OR  S  ’(NIL))))) 

(DEFUN  UNIFY-HATCH  (A  B  S) 

(COND  ( (EQ  A  B>  S) 

((ATOM  A) 

(AND  (NOT  (AT0I1  B) >  (VARIABLE  B)  (UNIFY-VARSET  B  A  S>)> 

((VARIABLE  A) 

(UNIFY-VARSET  DISH 
((ATOfl  B>  NIL) 

((VARIABLE  B)  (UNIFY-VARSET  BAS)) 

(  <T 

((LAftBOA  (S) 

(AND  S  (UNIFY-HATCH  (CDR  A)  (COR  B)  S)>> 

(UNIFY-HATCH  (CAR  A)  (CAR  B)  S>>>>> 

(DEFUN  UNIFY-VARSET  (VAR  NEUVAL  S> 

(COND  ( (EQUAL  VAR  NEUVAL)  S) 

(T  ( (LANBDA  (VCELL) 

(COND  (VCELL  (UNIFY-HATCH  (COR  WELL)  NEUVAL  S)> 

((UNIFY-FREEFOR  VAR  NEUVAL  S> 

(CONS  (CONS  VAR  NEUVAL)  S>)>> 

(ASSOC  VAR  S))>>> 

(DECLARE  (SPECIAL  eCDR-VAR*  *E*>) 

(DEFUN  UN.FY-FREEFOR  (VAR  EXP  *E*> 

(LET  (UCOR-VAR#  (COR  VAR))) 

(UNIFY-FREEFOR-LOOP  EXP))) 

(OEFUN  UNIFY-FREEFOR-LOOP  (E) 

(COND  ((ATOH  E>> 

((VARIABLE  E) 

(AND  (NOT  (EQ  (COR  E)  «CDR-VAR*>> 

(UNIFY-FREEFOR-LOOP  (COR  (ASSOC  E  eEe)>))> 

(T  (AND  (UNIFY-FREEFOR-LOOP  (CAR  E>) 

(UNIFY-FREEFOR-LOOP  (COR  E)))>)) 

c 


(OECLARE  (UNSPECIAL  eCOR-VAR*  *E*>) 
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INSTANCE  takes  a  pattern  and  a  substitution  and  returns  an  expression 
formed  by  substituting  the  substitutions  into  the  pattern  and  standardizing 
all  variables  apart. Boy•,'Moo,• 

(DECLARE  (SPECIAL  *SUB*  *NEUSUB*>) 

(DEFUN  INSTANCE  (EXP  *SUB*> 

(LET  (UNEUSUB*  NIL))  (INSTANCE-LOOP  EXP))) 

(OEFUN  INSTANCE-LOOP  (E) 

(CONO  UAT0H  E)  E) 

((VARIABLE  E> 

(LET  ( (VCELL  (ASSOC  E  *NEUSUB*>>) 

(COND  (VCELL  (COR  VCELL)) 

(T  (SETQ  VCELL  (ASSOC  E  »SUB*>> 

(COND  (VCELL  (CDAR  (SETQ  *NEUSUB* 

(CONS 

(CONS  E  (INSTANCE -LOOP  (COR  VCELL))) 

•NEUSUB*) >>> 

(T  (COAR 
(SETQ 
•NEUSUB* 

(CONS 

(CONS  E  ( INSTANCE -VCENS  (COR  E))> 

•NEUSUB*))))))))) 

(T  (CONS  (INSTANCE-LOOP  (CAR  E>> 

(INSTANCE -LOOP  (COR  £>>>>>> 

(DECLARE  (UNSPECIAL  *SUB*  *NEUSUB*>> 

(OEFUN  INSTANCE-VGENS  (VNADE) 

(CONS  Vi  (CONS  (CAR  VNAftE) 

(SETQ  *CENSYH -COUNTER*  <*  *CENSYN-COUNTER*  !))))> 
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COMPARE  takes  two  expressions,  A  and  B,  as  input.  If  B  is  a  variant 
of  A  it  returns  (variant  substitution*) .  If  A  subsumes  B  it  returns  (subsunes 
<subst i tut ion>) .  If  B  subsumes  A  it  returns  (Subsuneo  substitution*) .  Otherwise  it 
returns  NIL.  At  any  point  in  the  comparison,  the  state  of  the  comparator 
may  be  that  either  a  variant  is  still  possible,  or  that  only  either  a 
subsumes  or  subsumption  is  possible.  These  three  cases  produce  the  three 
subroutines  of  COMPARE. 

(DECLARE  (SPECIAL  oTYPE*) ) 

(DEFUN  C0I1PARE  (A  B) 

(LET  ( (oTYPE*  ’VARIANT)) 

(LET  ((S  (CONPARE-VAR I ANT-NATCH  A  B  ’(NIL)))) 

(ANO  S  (LIST  oTYPE*  S>>>>> 

(OEFUN  CONPARE-VAR I ANT-NATCH  (A  B  S) 

(COND  ( (EQ  A  B)  S) 

(<AT0H  A)  (SETQ  oTYPE*  ’SUBSUNEO)  (CONPARE-SUBSUNEO-NATCH  A  B  S>> 

((VARIABLE  A) 

(COND  ((ANO  (NOT  (ATON  B>>  (VARIABLE  B>) 

(LET  ( (VCELL  (ASSOC  AS))) 

(CONO  (VCELL 

(COND  ((EQUAL  (COR  VCELL)  B>  S) 

(T  (SETQ  oTYPE*  ’SUBSUNEO) 

(CONPARE-SUBSUNEO-NATCH  A  B  S)>>) 

((RASSOC  B  S> 

(CONPARE-SUBSUNES-NATCH  A  B  SI) 

(T  (CONS  (CONS  A  B)  S))>>> 

(T  (SETQ  oTYPE*  ’SUBSUNES)  (CONPARE-SUBSUNES-NATCH  A  B  S>>)> 

((ATON  B)  NIL) 

((VARIABLE  B) 

(SETQ  oTYPE*  ’SUBSUNEO) 

(CONPARE-SUBSUNEO-NATCH  A  I  SI) 

((SETQ  S  (CONPARE-VAR I ANT-NATCH  (CAR  A)  (CAR  B>  S>) 

(CONPARE-VAR I ANT-NATCH  (COR  A)  (COR  B)  S))>) 

(DECLARE  (UNSPECIAL  oTYPE*)) 

(OEFUN  CONPARE-SUBSUNES-NATCH  (A  B  S) 

(CONO  ((EQ  A  B)  S) 

((ATON  A)  NIL) 

((VARIABLE  A) 

(LET  ((VCELL  (ASSOC  AS))) 

(CONO  (VCELL  (ANO  (EQUAL  (COR  VCELL)  B)  S)> 

(T  (CONS  (CONS  A  B)  S>>>>> 

((ATON  B)  NIL) 

((SETQ  S  (CONPARE-SUBSUNES-NATCH  (CAR  R)  (CAR  B)  S>> 

(CONPARE-SUBSUNES-NATCH  (COR  A)  (COR  B)  S)>>> 
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(DEFUN  COnPflRE-SUBSUnED-nRTCH  (A  B  S) 

(COND  ( <EQ  A  B)  S> 

<<AT0n  B)  NIL) 

((VARIABLE  B) 

(LET  ( (VCELL  (RASSOC  BSD) 

(CONO  (VCELL  (ANO  (EQUAL  (CAR  VCELL)  A)  S)> 

(T  (CONS  (CONS  A  B>  S>>>)> 

<(ATOn  A)  NIL) 

( (SETQ  S  (COKPARr-SUBSUnEO-IIATCH  (CAR  A)  (CAR  B)  S>) 

(COnPARE-SUBSUKES-IIATCH  (COR  A)  (COR  B)  S>>>> 

RASSOC  Is  soaething  of  an  invarse  ASSOC,  which  searches  an 
association  list  for  an  association  whose  CDR  Matches  the  supplied  hey. 

(OEFUN  RASSOC  (KEY  ALIST) 

(00  ((L  ALIST  (COR  L>)>  ((NULL  L)  NIL) 

(CONO  ((EQUAL  KEY  (COAR  L>>  (RETURN  (CAR  L>))>>> 


"7  Y  T  . 1 
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THE  DISCRIMINATION  NETWORK 

The  following  functions  implement  a  discrimination  net  data  base. 
Ignoring  the  use  of  the  hash  table  for  the  moment,  let  us  first  understand 
how  a  discrimination  network  is  built.  Consider  the  problem  of  classifying 
the  S-expression  in  <b  .  c>  o> .  Although  internally,  this  expression  is  a 
tree,  its  structure  can  be  expressed  as  a  string  of  tokens  (as  for  PRINTing 
it).  In  this  case,  the  stream  of  tokens  used  to  discriminate  is: 

*D0UN*  R  *00UN*  B  *UP*  C  0  *UP*  NIL 

A  related  expression,  <r  ibci  d>,  translates  into: 

*D0UN*  R  *D0MN*  B  C  *UP*  NIL  D  *UP*  NIL 


Given  these  two  expressions,  we  would  construct  a  discrimination  net  with 
the  following  structure: 


Given  any  expression,  we  extend  the  discrimination  network,  if  necessary, 
and  return  the  bucket  represented  by  the  appropriate  leaf  of  the 
discrimination  network. 


A  variable  may  appear  in  any  position  of  an  expression  to  be  Indexed. 
Each  node  of  the  discrimination  network  contains  a  special  pointer  to  the 
subindex  for  token  streams  beginning  with  a  variable. 

An  interesting  complexity  in  this  system  is  that  many  structures 
share  the  same  discrimination  subnetworks.  We  assume  the  user  will  use 
lists  to  represent  logic-like  terms.  These  denote  the  semantic  objects 
being  dealt  with.  It  thus  makes  sense  that  EQUAL  or  VARIANT  terms  be 
uniquely  represented  in  the  network.  This  is  accomplished  by 
discriminating  every  non-atomic  term  from  the  top  of  the  network  and  then 
using  the  resulting  bucket  as  the  token  for  that  term  in  every  stream 
containing  that  term. 
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This  causes  a  painful  problem:  There  is  now  a  token  for  every  tern,  not 
just  every  atom.  Furthermore,  every  such  token  must  appear  in  the  top- 
level  node  of  the  network.  This  makes  it  unfeasible  to  use  a  simple  ASSOC 
of  one  of  these  tokens  on  a  part  of  the  node  to  do  a  dispatch.  Here  we 
introduce  a  2-key  hash-table  to  do  our  associations.  Given  a  token  and  a 
discrimination-node,  we  hash-retrieve  an  a-list.  An  element  of  this  a-list 
beginning  with  our  keys  has  the  required  subindex.  To  introduce  further 
possible  bugs,  we  bubble  the  association  forward  in  the  hash-entry. Donald  Dock 

There  are  several  global  variables  in  the  discrimination  net  data 
base.  *DN*  contains  the  discrimination  net  proper,  and  *HASH-ARRAY* 
contains  the  hash  table  that  the  discrimination  net  indexes.  ‘HASH-ARRAY- 
SIZE*  is  the  size  of  the  hash  array,  and  *DOWN*,  *UP*,  and  *NUMBER*  are 
special  tokens  used  to  represent  the  special  types  of  tokens  that  construct 
items  entered  into  the  net. 

(DECLARE  (SPECIAL  #0N#  #00UN#  #UP#  *NUHBER*  tHASH-ARRAY#  •HRSH-ARRAY-S IZE*) ) 

DBINIT  initializes  a  supplied  variable  to  contain  an  empty  data  base. 

(DEFUN  DBINIT  () 

(SETQ  »00UN*  (LIST  •#D0UN#>> 

(SETO  *UP*  (LIST  >*UP*>> 

(SETQ  #NUHBER#  (LIST  ’*NUHBER*)> 

(SETQ  *HASH-ARRAY-SI2E*  1021.) 

(♦ARRAY  ’  ♦HASH-ARRAY#  T  ♦HASH-ARRAY -SIZE#) 

(SETO  #0N#  (LIST  NIL))) 

STUFF  retrieves  the  list  of  items  from  a  data  base  bucket. 

(DEFUN  STUFF  (BUCKET)  (CDR  BUCKET)) 

INSERT- IN-BUCKET  does  what  it  says. 

(DEFUN  INSERT-IN-BUCKET  (l TEH  BUCKED 

(RPLACO  BUCKET  (CONS  ITEM  (COR  BUCKET)))) 

BUCKET  returns  the  bucket  of  items  from  a  data  base  corresponding  to 
the  supplied  expression  and  substitution,  extending  the  network  if 
necessary  to  create  the  bucket  for  the  new  expression. 

(DEFUN  BUCKET  (EXPRESSION  ALIST  TYPE) 

(LET  ((B  (SUB-BUCKET  EXPRESSION  ALIST  #0N#)>> 

(OR  (HASH-GET  TYPE  B) 

(LET  ((NEUIND  (LIST  B>>> 

(HASH-PUT  NEUIND  TYPE) 

NEUIND)))) 
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SUB-BUCKET  does  the  dirty  work  for  BUCKET  by  producing  the 
discrimination  net  token  that  BUCKET  will  use  to  index  into  the  hash-table. 
The  main  loop  of  the  program  is  either  to  discriminate  a  list,  or  to 
discriminate  a  thing  representing  a  term  --  that  is,  an  atom  or  a  list 
which  is  not  a  sublist  of  the  pattern  being  indexed.  The  process  of 
discrimination  is  termed  "walking  a  path".  Variables  are  not  distinguished 
from  each  other  when  discriminating  a  pattern.  If  the  token  being 
discriminated  on  is  a  variable,  the  unique  variable  sub-index  of  the 
discrimination  net  node  is  retrieved  and  followed.  If  the  token  is  not  a 
variable,  it  must  be  looked  up  in  the  table  of  tokens  known  at  this  node. 
If  the  token  does  not  exist  in  the  table  yet,  it  is  added.  The  table  is 
maintained  in  the  same  hash-table  as  is  used  for  indexing  the  buckets. 
This  means  that  the  bubbling  of  the  hash-table  entries  is  constantly 
rearranging  the  structure  of  the  discrimination  net  in  accordance  with 
those  paths  that  are  followed  most  frequently. 


de  Kleer,  Doyle,  Rich,  Steele  <  SuetMn 


40 


Rn  Annotated  Interpreter 


(DECLARE  (SPECIAL  eALISTe  eINDEX*)) 

(DEFUN  SUB-BUCKET  (EXPRESSION  eALISTe  elNOEXe) 

(SB-UALK-TH1NC  EXPRESSION  eINDEXe)) 

(DEFUN  SB-URLK-LIST  (FRRCHENT  SUBINDEX) 

(COND  URTOH  FRRCHENT) 

(SB-GET-SUBINDEX  (IF  (NUHBERP  FRRCHENT) 
eNUHBERe 
FRRCHENT) 

(SB-GET-SUBINDEX  eUPe  SUBINDEX))) 

( (VARIABLE  FRRCHENT) 

(LET  ( (VCELL  (RSSOC  FRRCHENT  eALISTe) >> 

(IF  VCELL 

(SB-URLK-LIST  (COR  VCELL)  SUBINDEX) 

(SB-GET-VRRIRBLE-SUB INDEX 
(SB-CET-SUB INDEX  eUPe  SUBINDEX))))) 

(T  (SB-URLK-LIST  (CDR  FRRCHENT) 

(SB-URLK-THINC  (CAR  FRRCHENT)  SUBINOEX))))) 

(DEFUN  SB-URLK-THING  (FRRCHENT  SUBINDEX) 

(COND  ((ATOH  FRRCHENT) 

(SB-GET-SUBINDEX  (IF  (NUHBERP  FRRCHENT)  eNUHBERe  FRAGMENT)  SUBINOEX)) 
((VARIABLE  FRRCHENT) 

(LET  ((VCELL  (RSSOC  FRRCHENT  eALISTe))) 

(IF  VCELL 

(SB-URLK-THING  (CDR  VCELL)  SUBINDEX) 

(SB-GET-VARIRBLE-SUB INDEX  SUBINDEX)))) 

(T  (SB-CE T-SUB 1 NOE X 

(SB-URLK-LIST  (COR  FRRCHENT) 

(SB-URLK-THING  (CAR  FRRCHENT)  eINDEXe)) 

(SB -GET -SUBINOEX  eDOUNe  SUBINDEX))))) 

(DECLARE  (UNSPECIRL  eALISTe  eINDEXe)) 

(OEFUN  SB-CE T-SUB INOEX  (THING  IND) 

(LET  ((R  (HRSH-CET  IND  THING))) 

(IF  R  (COR  R) 

(LET  ((NEUIND  (LIST  THING  NIL))) 

(HASH -PUT  NEUIND  INO) 

(RPLRCO  IND  (CONS  NEUINO  (COR  IND))) 

(CDR  NEUINO))))) 

(DEFUN  SB -GE T -VAR IABLE-SU8 INDEX  (IND) 

(OR  (CAR  IND)  (CAR  (RPLACA  IND  (LIST  NIL))))) 


d*  (Clear,  Doyle,  Rich,  Steel*  ft  SuitMn 


41 


Rn  Rnnotated  Interpreter 


FETCH  returns  a  list  of  items  from  a  data  base  which  are  candidates 
for  unification  with  the  supplied  pattern  relative  to  the  supplied 
substitution.  In  previous  versions  of  this  program,  FETCH  returned  a 
stream  which  would  generate  the  elements  of  this  list  one-by-one.  This 
increased  the  complexity  of  the  program  considerably.  The  stream  version 
was  abandoned  due  to  estimates  that  the  simple  list-producing  version  was 
more  efficient  in  a  system  like  AMORD,  which  tries  to  run  every  assertion 
on  every  rule.  FETCH  calls  on  SUB-FETCH  to  produce  a  list  of  lndlcies  into 
the  hash-table  corresponding  to  the  list  of  all  tokens  in  the  net  which  are 
candidates  for  matching  the  supplied  pattern.  The  contents  of  these 
buckets  are  then  unioned  together  and  returned. 

(DEFUN  FETCH  (PRTTERN  RUST  TYPE) 

(DO  ((L  (SUB-FETCH  PRTTERN  RUST  *DN«)  (COR  l>) 

(RNS 

NIL 

(APPEND  (COR  (HRSH-CET  TYPE  (CRR  L>)> 

RNS>>> 

((NULL  L)  RNS))) 

The  complexity  of  SUB-FETCH  derives  from  the  treatment  of  variables, 
which  can  occur  in  both  the  fetch  patterns  and  in  the  stored  expressions. 
Variables  in  the  fetch  pattern  must  match  only  well-formed  subexpressions. 
But  expressions  are  recursively  defined  sequences  of  tokens;  hence  the 
parenthesis  grammar  must  be  counted  out.  We  also  allow  terminal  segments 
(for  example  (A  .  :X> )  in  both  patterns  and  stored  expressions.  This  leads 
to  a  case  analysis  because  the  initial  conditions  of  the  counting  argument 
have  to  be  considered.  But  all  of  this  analysis  serves  only  to  select  out 
those  buckets  which  contain  the  candidates  for  the  match.  Throughout  the 
program,  all  collected  buckets  are  unioned  together  (via  APPEND,  since  each 
item  is  in  a  unique  bucket),  and  the  resulting  list  passed  back. 

Like  SUB-BUCKET,  SUB-FETCH  must  walk  down  the  pattern  different  ways 
as  the  item  being  discriminated  is  a  list  or  a  term-thlng.  The  sub-index 
retrieval  for  non-variable  tokens  is  much  like  that  of  SUB-BUCKET.  The 
true  complexity  arises  in  discriminating  variable  tokens,  since  there  can 
be  many  sub-indicies  matching  the  variable,  and  the  paths  corresponding  to 
each  of  these  must  be  followed.  There  are  two  sets  of  paths  to  be  followed 
from  a  variable  token,  corresponding  to  the  variable  matching  lists  or 
things. 
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(DECLARE  (SPECIAL  *ALIST*  *  INDEX*)) 

(DEFUN  SUB-FETCH  (PATTERN  *ALIST*  elNDEX*) 

(SF-UALK-THING  PATTERN  (LIST  elNDEX*))) 

(OEFUN  SF-UALK-LIST  (FRAGI1ENT  SUBINDICES) 

(COND  ((ATOM  FRAGMENT) 

(SF-GET-ATOI1-SUB INDICES  FRAGMENT 

(SF-GET-SUBINDICES  *UP*  SUBINDICES))) 

((VARIABLE  FRAGMENT) 

(LET  ( (VCELL  (ASSOC  FRAGMENT  *ALIST*))> 

(IF  VCELL  (SF-UALK-LIST  (CDR  VCELL)  SUBINDICES) 

(SF -GET-VARIABLE-LIST  SUBINDICES)))) 

(T  (NCONC  (SF-UALK-LIST  (COR  FRAGMENT) 

(SF-UALK-THING  (CAR  FRAGMENT)  SUBINOICES)) 
(SF-NEXTV  (SF -GET-SUB I NO ICES  *UP*  SUBINDICES)) )))) 

(OEFUN  SF-UALK-THING  (FRAGMENT  SUBINDICES) 

(CONO  ((ATOM  FRAGMENT) 

(SF -CE T -ATOM-SUB INDICES  FRAGMENT  SUBINDICES)) 

((VARIABLE  FRAGMENT) 

(LET  ((VCELL  (ASSOC  FRAGMENT  *ALIST*>)> 

(IF  VCELL  (SF-UALK-THING  (COR  VCELL)  SUBINDICES) 
(SF-GET-VARIABLE-THING  SUBINOICES)))) 

(T  (DO  ((TOKEN-LIST 

(SF-UALK-LIST  (COR  FRAGMENT) 

(SF-UALK-THING  (CAR  FRAGMENT) 

(LIST  elNOEX*))) 

(COR  TOKEN-LIST)) 

(DOUN-INDICES  (SF-GET-SUBINDICES  *OOUN*  SUBINOICES)) 

(ANS 

(SF-NEXTV  SUB  INDICES) 

(NCONC  (SF-GET-SUBINDICES  (CAR  TOKEN-LIST) 

DOUN-INOICES) 

ANSI)) 

((NULL  TOKEN-LIST)  ANS))))) 

(OECLARE  (UNSPECIAL  *AL!ST*  elNDEX*)) 

(DECLARE  (SPECIAL  eTHINGe) > 

(OEFUN  SF-GET-SUBINDICES  WTH1NG*  INDICES) 

(SF -GET-SUB INDICES1  INDICES)) 

(DEFUN  SF -GE T -SUB I NO ICES 1  (INDICES) 

(AND  INDICES 

(LET  ((A  (HASH-GET  (CAR  INDICES)  eTHING*))) 

(IF  R 

(CONS  (CDR  A)  (SF -GET-SUB INDICES!  (CDR  INDICES))) 

(SF -GET-SUB INO ICES 1  (COR  1N0ICES) > ) > > > 
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(OEFUN  SF-GET-ATOH-SUB INDICES  (TNG  INDICES) 

<LET  ((aTHINGa  (IF  (NUHBERP  TNG)  aNUfIBER*  TNG))) 

(SF -GET-ATOH-SUB INO ICES 1  INDICES))) 

(OEFUN  SF -GE T - ATOft-SUB INDICESl  (INDICES) 

(AND  INDICES 

(LET  ((A  (HASH-GET  (CAR  INOICES)  aTHINGa))) 

(CONO  (A  (IF  (CAAR  INDICES) 

(CONS  (COR  A) 

(CONS  (CAAR  INOICES) 

(SF -GET-ATOH-SUB INO ICESi  (COR  INOICES)))) 
(CONS  (COR  A)  (SF-CET-ATOH-SUBINOICESl  (COR  INOICES))))) 
((CAAR  INOICES) 

(CONS  (CAAR  INDICES) 

(SF-GET-ATOH-SUB INDICESl  (COR  INOICES)))) 

(T  (SF-GET-ATOfl-SUB INO ICESI  (COR  INDICES)) >)>>> 

(DECLARE  (UNSPECIAL  aTHINGa)) 

(OEFUN  SF-NEXTV  (INOICES) 

(COHO  ((NULL  INOICES)  NIL) 

((CAAR  INDICES)  • 

(CONS  (CAAR  INDICES)  (SF-NEXTV  (COR  INOICES)))) 

(T  (SF-NEXTV  (COR  INOICES))))) 

(OECLARE  (SPECIAL  aANSa)) 

(DEFUN  SF -GET-VARIABLE-LIST  (INOICES) 

(PROG  (aANSa) 

(HAPC  ’ SF-CVL  INOICES) 

(RETURN  aANSa))) 

(OEFUN  SF-GVL  (I) 

(HAPC  ’ (LAHBOA  (ASUB) 

(CONO  ((EQ  (CAR  ASUB)  aUPa) 

(HAPC  '(LAHBOA  (AS)  (SETO  aANSa  (CONS  (COR  AS)  aANSa))) 
(COOR  ASUB)) 

(AND  (CAOR  ASUB)  (SETO  aANSa  (CONS  (CAOR  ASUB)  aANSa)))) 
((EQ  (CAR  ASUB)  aDOUNa) 

(HAPC  '(LAHBOA  (AS)  (SF-GVL  (COR  AS)))  (COOR  ASUB)) 

(AND  (CAOR  ASUB)  (SF-CVL  (CAOR  ASUB)))) 

(T  (SF-CVL  (COR  ASUB))))) 

(COR  I)) 

(AND  (CAR  I)  (SF-CVL  (CAR  I)))) 

(DECLARE  (UNSPECIAL  aANSa)) 
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(DEFUN  SF-GET-VRR I ABLE -THING  (INDICES) 

(PROG  (RNS) 

(HHPC  ’ (LRH60R  (I) 

(HRPC  '  (LRtlBDn  (RSUB) 

(CONO  ((EQ  (CRR  RSUB)  *UP»)  NIL) 

((EQ  (CRR  RSUB)  aOOUN*) 

(HRPC  ’  (LRNBDfl  (RS) 

(SETQ  RNS  (CONS  (COR  RS) 

RNS) ) ) 

(COOR  RSUB)) 

(IF  (CRDR  RSUB) 

(SETQ  RNS  (CONS  (CROR  RSUB)  RNS>>>> 

(T  (SETQ  RNS  (CONS  (COR  RSUB)  RNS))))) 

(COR  I>> 

(IF  (CRR  I)  (SETQ  RNS  (CONS  (CRR  I)  RNS)))) 

INDICES) 

(RETURN  RNS) > ) 

The  following  functions  implement  the  hash  table  for  associations  used  in 
making  the  token  dispatch  step  of  the  discrimination  more  efficient. 

(DECLRRE  (FIXNUH  *HRSH-RRRRY-S I ZE*  (HRSH-NUHBER  NOTYPE  NOTYPE)  NUtt) 

(ARRAY*  (NOTYPE  UHRSH-fiRRAY*  ?)))) 

HASH-GET  retrieves  a  specified  thing  from  the  hash  table  of  the 
supplied  data  base. 

(OEFUN  HASH-GET  (INDEX  THING) 

(COR  (2-BSSQ  INDEX  THING 

(•HRSH-RRRRY*  (HRSH-NUHBER  INDEX  THING))))) 

HASH-PUT  inserts  a  new  thing  into  the  hash  table  of  the  given  date 

base. 

(OEFUN  HRSH-PUT  (NEUINOEX  INDEX) 

( (LRHBOR  (NUH) 

(STORE  UHASH-ARRAY*  NUH) 

(CONS  (CONS  INDEX  NEUINOEX) 

(*HASH-RRRAY*  NUH)))) 

(HRSH-NUHBER  INDEX  (CRR  NEUINOEX)))) 


( 
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This  is  the  ubiquitous  number  computer. 

(DEFUN  HASH-NUHBER  (KEY1  KEY2) 

(V  (BOOLE  6  (HAKNUH  KE Yll  (HAKNUH  «Y2>>  |X0R 

•HASH-ARRAY-SIZE*) > 

2-BSSQ  searches  an  association  list  for  an  association  of  the  pairing 
of  the  supplied  two  keys,  and  for  efficiency  [Rivest  1976],  bubbles  the 
association  one  step  towards  the  front  of  the  association  list. 

.  (DEFUN  2-BSSQ  (K1  K2  L) 

(PROG  (LI  L2> 

(CONO  ((NULL  L)  (RETURN  NIL)) 

((AND  (EQ  K1  (CAAR  L)>  (EQ  K2  (CROAR  L))> 

(RETURN  (CAR  L>>>) 

(SETQ  L2  L) 

LP  (SETQ  LI  (COR  L2>) 

(CONO  ((NULL  LI)  (RETURN  NIL)) 

((AND  (EQ  K1  (CAAR  LI))  (EQ  K2  (CROAR  LI))) 

(RPLACA  L2 

(PR0G2  NIL  (CAR  U) 

(RPLACA  LI  (CAR  L2>))) 

(RETURN  (CAR  L2)))) 

(SETQ  L2  (COR  Ll)> 

(CONO  ((NULL  L2>  (RETURN  NIL)) 

((ANO  (EQ  K1  (CAAR  L2))  (EQ  IC2  (CROAR  L2))) 

(RPLACA  LI 

(PR0G2  NIL  (CAR  L2) 

(RPLACA  L2  (CAR  LI)))) 

(RETURN  (CAR  LI)))) 

(GO  LP>>) 


This  concludes  the  listing  of  the  interpreter 
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Notes 


Notes 


AMORD 

A  Miracle  of  Rare  Device,  a  name  taken  (by  Doyle)  fro»  S.  T. 
Coleridge's  poem  Kubla  Khan. 

Donald  Duck 

If  you  think  the  structure  of  our  discrimination  network  is  devious, 
you  should  see  the  previous  version,  which  generates  candidates 
incrementally.  But  even  that  program  doesn't  hold  a  candle  to  Drew 
McDermott's  Donald  Duck  discrimination  network! 

Explicit  Control 

A  more  detailed  discussion  of  the  technique  of  explicit  control 
encouraged  by  AMORD  can  be  found  in  [de  Kleer,  Doyle,  Steele  and  Sussman 
1977]. 

Godel 

Self-referential  facts  cannot  be  recognized,  as  the  order  in  which 
rule  environments  are  constructed  precludes  rules  with  patterns  like  (if 

(CRETIN  : F > »  . 

Boyer-Moore 

Doyle  and  Sussman  experimented  with  the  use  of  the  Boyer-Moore 
structure  sharing  implementation  of  assertions.  In  benchmark  tests  it  was 
found  that  (in  the  current  implementation)  the  average  rule  consumed  some 
20  words  less  than  the  average  assertion.  Since  the  only  real  difference 
is  that  rules  share  structure,  while  each  assertion  has  its  own  instance  of 
its  pattern,  this  led  to  hopes  of  space  saving  by  moving  to  a  more 
efficient  representation.  Unfortunately,  calculations  showed  that  this 
more  complicated  scheme  would  not  result  in  very  significant  space  savings. 
In  addition,  its  implementation  seems  to  entail  a  very  significant  amount 
of  computation  in  a  system  like  AMORD,  in  which  new  assertions  must  be 
checked  against  the  data  base  for  subsumptions.  While  the  routines  for 
unification  and  instancing  are  simple  to  write  and  execute  efficiently,  the 
comparison  routines  seem  to  be  much  more  complicated  and  very  much  less 
efficient.  Our  experience  with  the  Boyer-Moore  representation  should  be 
compared  with  that  of  McDermott  [1977]. 

\ 

MacLISP 

MacLISP  [Moon  1974]  is  a  powerful  dialect  of  LISP  developed  by  the 
MIT  Artificial  Intelligence  Laboratory. 

IMS 

The  Truth  Maintenance  System  is  a  program  developed  by  Doyla 
[  1978a, b].  Section  3  summarizes  its  function  and  use. 
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